perm filename DD.SAI[MF,ALS] blob
sn#805197 filedate 1985-09-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00024 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 Begin "dvidd"
C00020 00003 Utility procedures and macros: TTYSET, ESCAPE, BREAK, EXIT, FILESIZE, CLEAN_UP, ERROR, PAGE_WARN, SCAN_FILENAME, INIT_TEXT, CHAR_STR, INIT_BREAK, PAUSE
C00028 00004 DVI input procedures: DVI_INIT, SETPOS, GETNEXT, GETINT, GETPREV
C00035 00005 ! These procedures are to simplify the byte access to the original GF
C00046 00006 Font file definitions and procedures: FIND_FONT, READ_FONT_FILE, PRELOAD_FONTS
C00092 00007 POSTAMBLE processes the postamble of the DVI file, reading in the fonts
C00099 00008 Page number handling: FIND_PAGES, GO_TO_PAGE
C00102 00009 MAKE_PEN constructs a pen polygon for use with SET_VECTOR
C00114 00010 WORK does the main processing of the DVI file
C00117 00011 INIT_DDBUF handles initialization of DDBUF that has to be done only once
C00120 00012 HELP_MESSAGE summarizes the commands to this program.
C00125 00013 DO_OUTPUT displays a portion of the lines in PAGEBUF, determined by
C00130 00014 BLANK_DDBUF fills all graphics words in the DDBUF array with blank
C00132 00015 SET_CHAR writes a character. Before calling it, HH and VV must be
C00140 00016 SET_RULE outputs a rule. H and V are the reference point, and
C00144 00017 RULE_PIXELS rounds a dimension in the DVI file into the correct
C00145 00018 SET_VECTOR draws a diagonal line between the point described by H1
C00175 00019 SET_RECTANGLE performs bit-shading on a rectangle. The meaning of
C00182 00020 SPECIAL_COMMAND handles \special commands in TeX input.
C00186 00021 DO_PAGE reads from the DVI file starting at the current position,
C00207 00022 Here is where WORK begins
C00220 00023 PROCESS_SWITCHES processes switches in the command line. The global
C00222 00024 Main program
C00225 ENDMK
C⊗;
Begin "dvidd"
Comment If DVI command codes change, check the BOP and PST arrays on this
page, and also look at codes in the procedures POSTAMBLE and DO_PAGE.;
Comment History:
August 82 Initial implementation.
16-Sep-82 Search for TFM file if PXL not found, preprocess TFM data,
and use character widths.
18-Sep-82 Added ε and λ commands, /M and /P switches.
20-Sep-82 Removed fontnumber restriction.
9-Oct-82 Fixed bug when font "at" size is different from document mag.
22-Oct-82 Clear screen to end of displayed area in DO_OUTPUT.
30-Oct-82 Changed constants to reflect new definition of a point.
2-Nov-82 Changed constants back after new definition retracted by DEK.
6-Jan-83 Added B, L, T commands.
13-Jan-83 Added \special point and join commands.
9-Feb-83 Check for ridiculous page size in POSTAMBLE procedure.
12-Feb-83 Added \special rectangle command.
21-Feb-83 "Character off page" messages limited to OFF_PAGE_MAX. Added }
command. Disabled ? command until text mode is implemented.
4-Mar-83 Fixed scanning of font file names > 6 characters long.
30-Mar-83 Font file preloading. /-F switch to disable preloaded fonts.
2-Apr-83 Blank DDBUF at the beginning of each page (supersedes 22-Oct-82
change). Continue after exit allowed.
31-May-83 Fixed CRLF problems in font-reading messages. Round to nearest
integer before computing font extension.
11-Sep-83 Added ` and ' commands. Made ? command show partial list of commands.
30-Sep-83 Fixed bug in finding font files, by making SCAN_FILENAME take a
parameter to control PPN defaulting.
29-Oct-83 Changed DEFAULT_MAG from 1500 to 1440. Made ` and ' shift less.
10-Nov-83 Added FORCING_PAGE_READ to fix bug.
9-Jun-84 (DEK) Kept HH from drifting more than one pixel from true value
20-Jun-84 (FY) Added π command (sends file to boise)
3-Jul-84 (FY) π and } commands cannot have <control> bit on (E compatibility)
24-Oct-84 (JDH) Changed line drawing specials so that they understand pen
widths in a way roughly compatible with DVIDOVER. Also changed
real to integer conversion function from FIX to FIXR and updated
all calculations to take this into account.
12-Nov-84 (JDH) Fixed small bugs in new vector drawing code. Setting pen size
to 0 sometimes caused initialization to be skipped, and there was
a bug in mark_right_vertex that only effected very large pens.
16-Feb-85 (JDH) Changed line drawing so widths are given in points (i.e. DVI units
scaled by 2↑16.) Also added aspect parameter for line drawing.
8-Mar-85 (FY) Added the @ and β@ commands to print file using DVIesp.
25-May-85 (JDH) Caused \special points to be reinitialized on each page.
26 Aug-85 (ALS) Inserted code to use .GF font files when available and to report
the loading of each GF font by printing a period. If the desired
.GF font is not found then the .PXL font file is used, if available
and again reported, in this case, by an asterisk.
Input from .GF files is converted to .PXL format at the time of
loading so as to preserve the original code as much as possible.
Modified the code so as to accept font files with as many as 256
glyphs and arranged the storage of all .GF fonts with space in the
directory for entries from GF_BC thru GF_EC (still leaving entries
from 0 thru 127 for .PXL files).
I left many commented-out print commands, that I found useful in
understanding the code and in debugging my additions to it.
4-Sept-85 (ALS) Fixed a bug the left glitches on the bottom of some glyphs
when the MF recorded glyph height (del_n) was oversize.
Record changes above this line.;
Comment To do: Correct computation of VV and make SET_RULE use HH and VV
Put HH and VV on stack?
(DEK) Correct HH computation as in DVItype?
Implement a "text display" mode
Log file for error messages
Mention unitialized \special{point}s
Cksum mismatch with preloaded font should cause disk read
Allow arguments to ←, →, `, and '
Suggested extensions:
O, N, and M commands
show info about postamble, etc.
DEK - how about ⊗XDVIDD from E that gets you back after ε or λ?
DEK - When a PXL file can't be found, but you do know the widths etc from
the TFM file, the program presently gives blanks for all the characters.
It would be nicer to have another default, namely rectangles based on
the height, width, and depth. Then a person can tell if his/her TeX
program is putting stuff in the right position, even when setting
say a title in a large font, or when using a Xerox font that MF can't make.
It wouldn't be hard to write a subroutine that pretends such a PXL file
is present...
Commands to position left and top to page margins.
Indication of page margins.
DEK - Maybe 3R could mean "go to relative page number 3", and a user could
define the offset amount via some other unused (line-editor) code.
;
require "{}<>" delimiters;
define DEBUG ← {};
define thru = {step 1 until},
downto = {step -1 until},
tab = '11, lf = '12, vt = '13, ff = '14, cr = '15,
alt = '175, bs = '177,
↓ = {'15&'12},
! = {comment};
define saf = {safe}; ! make it {} for debugging;
require "6A" compiler_switches;
! Use KL-10 hardware instead of UUOs for real ↔ integer conversion.
N.B. Conversion function is ROUND(x) NOT FLOOR(x);
external integer procedure armak(integer lb,ub,dims);
define ppsel = {'702000000000}; ! UUO codes not known by SAIL;
define dpypos = {'702100000000};
define dpysiz = {'702140000000};
define ddupg = {'715140000000};
define fix = {'122000000000}; ! not a UUO, but SAIL doesn't know it;
! There are at least three systems of units used by this program. Hopefully,
all comments are accurate as to which units are being used. The definitions
are as follows:
RSUs are 10↑-7 meter
DVI file units are whatever the DVI file writer chooses. The variable
UNITSCALE is the number of RSUs per DVI file unit.
FIXes are used to express the dimensions of characters. One
FIX is 1/(2↑20) times the design size of the font.
;
define aspect = {1.0}; ! expansion factor for y-dimensions.
(currently only affects line drawing);
define max_pen_size = {200.0}; ! maximum line drawing pen size in pixels;
define PenUnitScale = {65536}; ! DVI units per a line width unit;
define PixelsPerInch = {70};
define PixelsPerRSU = {(PixelsPerInch/(100000.*2.54))};
define stacksize = 200; ! for version 1 DVI files, only;
define window_lines = 300; ! amount that <form> and <vt> move;
define small_lines = 40; ! amount that B and T move;
define default_mag = 1440;
define page_warn_max = 5; ! maximum number of "off page" messages;
! Keeping track of the page size is rather complicated. The DVI file contains
"maximum" values of H and V, but then it may go ahead and violate these, for
example when it sets an overfull box. It may also cause H and V to become
less than zero, or a character's left edge may be at pixel -1. So, we keep
several sets of variables.;
integer max_hh, max_vv; ! From the DVI file (converted to pixels);
integer lowest_hh, highest_hh, lowest_vv, highest_vv;
! Actual limits found in the current page.;
integer left_hh, right_hh, top_vv, bottom_vv;
! Limits beyond which we will not typeset;
! LEFT_HH and RIGHT_HH+1 should be multiples of 32, since there are 32 bits of
raster information stored in each word of a DataDisc program. The following
constants determine how much extra space is allocated.;
define extra_rows = 96; ! Extra rows at top and bottom;
define extra_cols = 96; ! Extra cols at left and right. Must be
a multiple of 32.;
! Global variables. (Some others are defined further on.);
boolean all_done; ! Flag set to exit the program;
preload_with 129,139; ! BOP commands in different versions;
saf integer array bop[1:2]; ! of DVI files;
integer brchar; ! Break character for I/O and scanning;
string cmd_line; ! Input command line;
real conv; ! Pixels per DVI file unit;
integer ddchan; ! Data Disc channel number (0 for ours);
integer ddflag; ! Are we on a Data Disc?;
string dskppn; ! Current alias in the form [PRJ,PRG];
integer dvichan; ! Input channel for the DVI file;
integer fontchan; ! Input channel for the GF files;
integer dvi_version; ! What type of DVI file is this?;
integer eof; ! For I/O;
integer flag; ! For I/O;
boolean forcing_page_read; ! To force positioning after exit and continue;
integer h, v, wamt, xamt, yamt, zamt; ! DVI quantities;
integer hh, vv; ! Current pixel equivalents of H and V;
external integer jobff, jobrel, jobsa; ! Lowcore pointers;
integer jobff_save; ! Used because SAIL doesn't update JOBFF;
integer lastpageptr; ! Byte number of last page in DVI file;
integer magnification; ! Magnification*1000 of DVI file;
integer num_pages; ! Number of pages, in version 2 DVI files;
integer page_warn_count; ! Number of warning messages left to
print before shutting up;
preload_with 131,248; ! Postamble commands in different versions;
saf integer array pst[1:2]; ! of DVI files;
boolean reading_fonts; ! TRUE if message has been printed;
integer row_size; ! Number of words in each row;
string special_string; ! Text of \special command;
integer stack_depth; ! Stack size, in version 2 DVI files;
integer stack_top; ! Index to data last pushed on STACK
(-1 if stack empty);
integer to_semi,to_slash,to_blank, ! break tables for scanning;
skip_blanks,remove_blanks,file_hack;
real unitscale; ! RSUs per DVI file unit;
external integer _skip_; ! See SAIL manual;
Comment Utility procedures and macros: TTYSET, ESCAPE, BREAK, EXIT, FILESIZE, CLEAN_UP, ERROR, PAGE_WARN, SCAN_FILENAME, INIT_TEXT, CHAR_STR, INIT_BREAK, PAUSE;
define ttyset(func,arg) = {call((-1 lsh 18) + location (((func) lsh 27) + (arg)), "ttyset")},
escape(char) = {ttyset(4, char)},
break(char) = {escape((char) + '400)},
exit(arg) = {quick_code calli arg,'12 end};
! FILESIZE returns the number of words in the file last LOOKUPed;
simple integer procedure filesize;
begin "filesize"
saf own integer array filedata[1:6];
fileinfo(filedata);
return(-(filedata[4] rot 18))
end "filesize";
! CLEAN_UP performs things needed to terminate the program.;
simple procedure clean_up;
begin "clean_up"
break("N"); ! Reset the screen;
release(dvichan);
call(0,"sleep");
call(0,"sleep");
call(0,"sleep");
end "clean_up";
! ERROR prints a message and aborts.;
simple procedure error(string mess);
begin "error"
clean_up;
outstr(mess & "." & ↓);
exit(0);
end "error";
! PAGE_WARN is used to print a warning, unless we have already printed enough
warnings for the current page.;
define page_warn(mess) = {begin
if page_warn_count > 0 then print(mess)
else if page_warn_count = 0 then
print("... plus more errors that we won't mention" & ↓);
page_warn_count ← page_warn_count - 1;
end};
! SCAN_FILENAME takes a filename and decomposes it into the name, extension, and
directory. These are stored in the global array FARRAY as FARRAY[0], FARRAY[1],
and FARRAY[2], respectively. If the second parameter is TRUE, then files whose
PPN equals the current alias PPN are shortened by leaving out the PPN.;
saf string array farray[0:2];
simple procedure scan_filename(string fname; boolean shorten);
begin "scan_filename"
integer name,exten,ppn; ! sixbit values;
string s;
name ← cvfil(fname,exten,ppn);
if shorten and ppn = call(0,"dskppn") then ppn ← 0;
farray[0] ← cv6str(name);
farray[1] ← if exten = 0 then null else "." & cv6str(exten);
if ppn = 0 then farray[2] ← null else begin
s ← cvxstr(ppn);
s ← "[" & s[1 to 3] & "," & s[4 to 6] & "]";
farray[2] ← scan(s,remove_blanks,brchar);
end;
end "scan_filename";
! INIT_TEXT turns a text string into a DataDisc program to display that string.
Adapted from SPIDER.SAI[CSP,SYS].;
simple procedure init_text (safe integer array buf; string text);
begin "init_text"
integer i;
define begy = 36;
buf[0] ← '000230002124;
buf[1] ← '004000023454;
dpb (begy-12, point (4, buf[1], 23));
dpb ((begy-14) lsh -4, point (5, buf[1], 15));
i ← 1;
while length (text) ≠ 0 do begin
if (i←i+1) ≥ arrinfo (buf, 2) then error("Text array too small!");
buf[i] ← cvasc (text) + 1;
text ← text[6 to ∞]
end;
buf[i←i+1] ← '4224;
buf[-4] ← location(buf[0]) + '240200 lsh 18;
buf[-3] ← i + 1;
buf[-1] ← location(buf[1])
end "init_text";
! CHAR_STR converts a character to a string representing it, for diagnostic
output.;
simple string procedure char_str(integer char);
begin "char_str"
string str;
str ← "";
if char land '200 then str ← str & "<ctrl>";
if char land '400 then str ← str & "<meta>";
case char land '177 of begin "case char"
[0] str ← str & "<nul>";
[tab] str ← str & "<tab>";
[lf] str ← str & "<lf>";
[vt] str ← str & "<vt>";
[ff] str ← str & "<form>";
[cr] str ← str & "<cr>";
[" "] str ← str & "<space>";
[alt] str ← str & "<alt>";
[bs] str ← str & "<bs>";
else str ← str & char
end "case char";
return(str);
end "char_str";
! INIT_BREAK sets up break tables for scanning of the command line,
strings in \special commands, and filenames.;
simple procedure init_break;
begin "init_break"
setbreak(to_semi←getbreak,";",null,"ins");
setbreak(to_slash←getbreak,"/"," "&tab,"ins");
setbreak(to_blank←getbreak," "&tab,null,"ins");
setbreak(skip_blanks←getbreak," "&tab,null,"xnr");
setbreak(remove_blanks←getbreak,null," "&tab,"ins");
setbreak(file_hack←getbreak,".[",null,"inrk");
end "init_break";
require init_break initialization;
! PAUSE is called to save state information about the program so that it can
be saved. When it is restarted, PAUSE returns.;
simple procedure pause;
begin "pause"
safe own integer array acs[0:'17];
jobff_save ← jobff;
jobff ← jobrel;
quick_code
label restart;
movem '17,acs['17]; ! save ACs;
movei '17,acs[0];
blt '17,acs['16];
movei 0,restart; ! set address to restart;
movem 0,jobsa;
calli 0,'12; ! exit;
restart:movsi '17,acs[0]; ! restore ACs;
blt '17,'17;
end;
jobff ← jobff_save;
end "pause";
Comment DVI input procedures: DVI_INIT, SETPOS, GETNEXT, GETINT, GETPREV;
! These procedures implement buffered byte I/O from the DVI file. The
following statements describe the meaning of various variables:
The "current byte position" is a number between 0 and 4*DVILENGTH-1.
The "current byte" is the byte at the current byte position.
The "previous byte" is the byte before the current byte.;
saf string array dvi_farray[0:2]; ! Parts of the filename;
saf integer array dviblock[0:127]; ! Holds record containing previous byte;
integer dvibytenum; ! The current byte position;
string dvifname; ! Name of the DVI file;
integer dvilength; ! Length of the DVI file, in words;
integer dvirecnum; ! The record number in the DVI file containing
the previous byte. (First record is 1, not 0.);
integer dviword; ! Holds the word containing the previous byte,
rotated so that previous byte is in bits 29-36;
integer dviwordnum; ! The index in DVIBLOCK of the word containing
the previous byte;
! DVI_INIT initializes the variables to dummy values, to force the right
thing to happen the first time SETPOS or GETNEXT is called.;
simple procedure dvi_init;
begin "dvi_init"
dvibytenum ← 0;
dvirecnum ← 0;
dviwordnum ← 127;
end "dvi_init";
require dvi_init initialization;
! SETPOS sets the current byte position in the DVI file to the byte position
given as its argument.;
simple procedure setpos(integer bytepos);
begin "setpos"
integer record;
! We read in the record containing the PREVIOUS byte, so that GETNEXT
and GETPREV will work correctly. This causes a wasted read whenever
BYTEPOS is exactly at the beginning of a record, but so what.;
if bytepos = 0 then begin
useti(dvichan,1); ! go to beginning of file;
dvi_init; ! set dummy values;
return
end;
dvibytenum ← bytepos;
bytepos ← bytepos - 1; ! point to previous byte;
record ← bytepos div (4*128) + 1;
if dvirecnum ≠ record then begin
useti(dvichan,record);
arryin(dvichan,dviblock[0],128);
dvirecnum ← record;
end;
dviwordnum ← (bytepos mod (4*128)) div 4;
dviword ← dviblock[dviwordnum] rot (8*(bytepos land 3 + 1));
end "setpos";
! GETNEXT returns the current byte in the DVI file, and then increments the
current byte position.;
simple integer procedure getnext;
begin "getnext"
if dvibytenum land 3 = 0 then begin
! Get new word;
if (dviwordnum ← dviwordnum + 1) = 128 then begin
! Read in next record;
arryin(dvichan,dviblock[0],128);
dvirecnum ← dvirecnum + 1;
dviwordnum ← 0;
end;
dviword ← dviblock[dviwordnum];
end;
dviword ← dviword rot 8; ! put next byte in lowest positions;
dvibytenum ← dvibytenum+1; ! number of the byte to be accessed next;
return(dviword land '377)
end "getnext";
define bites2 = {((getnext lsh 8) lor getnext)},
bites3 = {((bites2 lsh 8) lor getnext)},
bites4 = {((bites3 lsh 8) lor getnext)};
define twobites = {((bites2 lsh 20) ash -20)},
threebites = {((bites3 lsh 12) ash -12)},
fourbites = {((bites4 lsh 4) ash -4)};
! Thus, a bite will fetch you some fresh bits (two,three and fourbites
give the equivalent in rsu's);
integer procedure getint; return((bites4 lsh 4) ash -4);
! GETPREV decrements the current byte position, and then returns the current
byte.;
simple integer procedure getprev;
begin "getprev"
integer result;
result ← dviword land '377;
dviword ← dviword rot -8;
if (dvibytenum ← dvibytenum - 1) land 3 = 0 then setpos(dvibytenum);
! SETPOS is called when the (new) previous byte is in a different word,
to load that word into DVIWORD.;
return(result)
end "getprev";
! These procedures are to simplify the byte access to the original GF
information that is read into a temporary array for processing. The
nomenclature follows the pattern that was used for an earlier version
of DVGFDD to simplify the conversion to the present somewhat faster
form. ;
integer gf_point,saved_ptr; ! Byte pointer;
! We will need a temporary array to hold the GF file as it is read in since
we do not yet know how large the font:data array will need to be.;
simple integer procedure gf_byte;
begin "gf_byte"
integer result;
result ← ldb(gf_point);
ibp(gf_point);
return(result)
end "gf_byte";
simple integer procedure get_gf_prev;
begin "get_gf_prev"
integer result;
if (gf_point lsh -30) = 28 then
gf_point ← gf_point -(24 lsh 30) - 1
else gf_point ←gf_point + (8 lsh 30);
result ← ldb(gf_point);
return(result)
end "get_gf_prev";
define bite2 = {((gf_byte lsh 8) lor gf_byte)},
bite3 = {((bite2 lsh 8) lor gf_byte)},
bite4 = {((bite3 lsh 8) lor gf_byte)};
define gf_halfword = {bite2};
define gf_signed_quad = {((bite4 lsh 4) ash -4)};
define gf_word = {bite4};
Comment Font file definitions and procedures: FIND_FONT, READ_FONT_FILE, PRELOAD_FONTS;
! GF commands;
define PAINT_0={0}, PAINT1={64}, PAINT2={65},
BOC={67}, BOC1={68}, EOC={69},
SKIP0={70}, SKIP1={71},
NEW_ROW_0={74}, NEW_ROW_164={238},
XXX1={239}, YYY={243}, NO_OP={244},
CHAR_LOC={245}, PRE={247}, POST={248}, POST_POST={249};
define gf = 1, tfm = 2, pxl = 3; ! File types we will read;
define tfmppn={"[TEX,SYS]"}; ! Default PPN for TFM files;
define gfppn={"[GF,SYS]"}; ! Default PPN for GF files;
define pxlppn={"[PXL,SYS]"}; ! Default PPN for PXL files;
! The following variables will be needed later in transforming the GF
information into the modified PXL format in which it is saved.;
integer c,w,b,dis,n,q,i,j,k,word_count; ! Misc variables;
integer words_per_row; ! The required number of words per row;
integer gfbc,gfec; ! Begining and ending char number;
integer dir_space; ! Defined as (gfec+1-gfbc) lsh 2;
integer dir_base; ! Defined as word_count - (gfbc lsh 2);
integer byte_hold,bytes_required,r_word,val; ! temporary registers;
integer min_m,max_m,min_n,max_n,del_m,del_n; ! Glyph parameters;
integer words_required; ! Space required to store font;
! saf integer array temp_directory[0:511]; ! PXL directory hold;
saf integer array temp_directory[0:1023]; ! PXL directory hold;
saf integer array btab[0:32]; ! Used to translate paint commands into pixels;
! For each font, we keep a record containing all its information. The array
DATA in this record is allocated after we have determined how large it
wil need to be. The gf data from the temporary hold_data array will be
processed and transfered to the following array. The font records
are linked together in a list by the NEXT field, with the most recently
used font always moved to the head of the list and pointed to by
CURRENT_FONT.;
record_class font (
record_pointer(font) next; ! Next font in list;
integer fontnumber; ! -1 for preloaded fonts;
integer file_type; ! GF, PXL or TFM;
integer length; ! Number of words in DATA;
integer base; ! The dir_base for this font;
integer dir; ! The directory relative location;
integer bc; ! The gfbc for this font;
integer ec; ! The gfec for this font;
string filename; ! WAITS name of file this font came from;
saf integer array data ! Will be [0:LENGTH-1];
);
record_pointer(font) current_font;
define preloaded = -1;
! CURRENT_FONT is a record pointer to the record for the current font. However,
for the sake of efficiency we let CURRENT_FONT_PTR be the location of the DATA
array for the current font. Also, we let CURRENT_FONT_DATA be the address of
the first word in the character information table at the end of the DATA
array and CURRENT_FONT_BASE be the reference point coinciding with
CURRENT_FONT_DATA if the font starts with a 0 glyph and being ahead of this
locaton by 4*GFBC if the first glyph number is greater than zero.
CURRENT_FONT_TYPE is either GF or TFM.;
integer current_font_ptr, current_font_data, current_font_type;
integer current_font_base, current_font_bc, current_font_ec;
integer current_font_size;
! FIND_FONT looks for a font with a given fontnumber. If it is found,
CURRENT_FONT, CURRENT_FONT_PTR, CURRENT_FONT_DATA, and CURRENT_FONT_TYPE are
set, and TRUE is returned. If it is not found, and the second parameter is
FALSE, then an error message is generated.;
boolean procedure find_font(integer fontnumber; boolean just_checking(false));
begin "find_font"
record_pointer(font) p,q;
p ← null_record;
q ← current_font;
while q ≠ null_record do begin "look"
if font:fontnumber[q] = fontnumber then begin "found"
if p ≠ null_record then begin
font:next[p] ← font:next[q];
font:next[q] ← current_font;
current_font ← q;
end;
current_font_ptr ← location(font:data[q][0]);
current_font_base ← current_font_ptr + font:base[q];
current_font_bc ← font:bc[q];
current_font_ec ← font:ec[q];
current_font_size ← current_font_ec + 1 - current_font_bc;
! print(" current_font_size at find = ",current_font_size,↓);
! current_font_data ← current_font_ptr + font:length[q] - 517;
current_font_data ← current_font_ptr + font:dir[q];
current_font_type ← font:file_type[q];
return(true);
end "found";
p ← q;
q ← font:next[q];
end "look";
if just_checking then return(false);
error("Font " & cvs(fontnumber) & " used but never defined");
end "find_font";
! READ_FONT_FILE tries to read a GF file for a given fontnumber. It assumes
that FONTCHAN has been opened already. We look on the directory given by
GFPPN, unless the DVI file specifies a different directory. If it is not
found there, we look for the TFM file instead. If neither is present, we
print a warning and set a flag so that we won't try to process the body of the
DVI file, but continue so that all non-existent font files can be noticed.
Since we are unable to use the directory information of the GF file
directly, we will find it convenient to accumulate the needed directory
information in a table as we first read the GF_POSTAMBLE and then update
and correct the entries as we convert the GF data into the PXL like form
in which it is to be saved.
We preprocess the Directory Information of a GF file so that "halfwords",
which are 16 bits long, are made into real PDP-10 halfwords (with sign
extension), and change the fourth word, which is the character width in FIXes,
to its width in DVI file units, which involves multiplying by a constant that
depends on the magnification. This is done so that the SET_CHAR procedure
will not have to do it each time it is called.
Upon return, CURRENT_FONT points to the font we have just read in.;
procedure read_font_file(integer fontnumber; string fontname;
real mag; integer cksum);
begin "read_font_file"
string filename,gf_filename,pxl_filename,s;
integer extension; ! Filename extension for GF file;
real fmult; ! RSUs per FIX for this font;
integer flength; ! Length of data in font file;
integer design_size; ! Designsize in font file;
integer font_cksum; ! Checksum in font file;
integer hppp; ! Parameter used to compute magnification;
integer file_type; ! GF or TFM;
record_pointer(font) new_font, p;
label pre_process;
label pre_pre_process;
! We compute the extension of the font file from the magnification. For
an unmagnified font, say CMR10, the file will be "CMR10.070" since the
full name is "CMR10.070GF". When the name contains more than three
digits, a letter is used for the first two digits. The letter "A" is used
for "10", "B" for "11", etc. up to "Z" for "35". An extension of "GF"
will be used, without further differentiation for any font where "36" or
highter is indicated.
E.g., CMR10 at 150pt, which is "CMR10.1050GF", will be "CMR10.A50".;
extension ← (PixelsPerInch * mag * magnification / 1000.0);
filename ← fontname; ! Preserve FONTNAME for error msg;
s ← scan(filename,file_hack,brchar);
if length(s) > 6 then s ← s[1 to 3] & s[∞-2 to ∞];
filename ← s & filename;
scan_filename(filename,false); ! Leave PPN intact;
if extension < 1000 then
begin
if farray[1] = "" then farray[1] ← "."
& (extension div 100 + "0")
& (extension mod 100 div 10 + "0")
& (extension mod 10 + "0");
end
else begin
if extension < 3600 then
begin
if farray[1] = "" then farray[1] ← "."
& (extension div 100 + "7")
& (extension mod 100 div 10 + "0")
& (extension mod 10 + "0");
end
else begin
if farray[1] = "" then farray[1] ← "."
& "G" & "F";
end;
end;
! Use PPN given in GF_FNAME, if any, else GFPPN.;
file_type ← gf;
filename ← farray[0] & farray[1] & farray[2];
if equ(farray[2],null) then filename ← filename & gfppn;
! print(↓,filename);
! See if we already have a font with this name (presumably preloaded).;
p ← current_font;
while p ≠ null_record do
if equ(font:filename[p],filename) then begin "got it"
if font:fontnumber[p] ≠ preloaded then begin "kludge"
! This happens when the same font is given two different
font numbers by TeX (e.g., "cmr10" and "CMR10"). Our
solution is to create a new font record, but have the data
array point to the existing data array.;
new_font ← new_record(font);
font:fontnumber[new_font] ← fontnumber;
font:file_type[new_font] ← font:file_type[p];
font:length[new_font] ← font:length[p];
font:base[new_font] ← font:base[p];
font:dir[new_font] ← font:dir[p];
font:bc[new_font] ← font:bc[p];
font:ec[new_font] ← font:ec[p];
font:filename[new_font] ← font:filename[p];
memory[location(font:data[new_font])] ← memory[location(font:data[p])];
font:next[new_font] ← current_font;
current_font ← new_font;
! The data in the array must have already been preprocessed,
so we are done.;
return
end "kludge";
font:fontnumber[p] ← fontnumber;
if not find_font(fontnumber,true) ! this sets CURRENT_FONT;
then error("Impossible font error - find a wizard");
flength ← font:length[p];
font_cksum ← font:data[p][flength-5] lsh -4;
! print("line 168 cksum ",font_cksum," flength ",flength,↓);
go to pre_process
end "got it"
else p ← font:next[p];
! Look for the font with the given filename.;
if fontnumber ≠ preloaded and not reading_fonts then begin
reading_fonts ← true;
print("Reading fonts");
end;
lookup(fontchan,filename,flag);
if not flag then print(" .");
if flag then
begin "look for PXL file"
! Couldn't find gf file. Look for PXL file on PPN given in FILENAME,
if any, else on PXLPPN (except when preloading).;
gf_filename ← filename; ! For error message;
filename ← fontname;
extension ← (PixelsPerInch * mag * magnification / 200.0);
s ← scan(filename,file_hack,brchar);
if length(s) > 6 then s ← s[1 to 3] & s[∞-2 to ∞];
filename ← s & filename;
scan_filename(filename,false); ! Leave PPN intact;
if extension < 1000 then
begin
if farray[1] = "" then farray[1] ← "."
& (extension div 100 + "0")
& (extension mod 100 div 10 + "0")
& (extension mod 10 + "0");
end
else begin
if extension < 3600 then
begin
if farray[1] = "" then farray[1] ← "."
& (extension div 100 + "7")
& (extension mod 100 div 10 + "0")
& (extension mod 10 + "0");
end
else begin
if farray[1] = "" then farray[1] ← "."
& "G" & "F";
end;
end;
! Use PPN given in PXL_FNAME, if any, else PXLPPN.;
file_type ← pxl;
filename ← farray[0] & farray[1] & farray[2];
if equ(farray[2],null) then filename ← filename & pxlppn;
! print(↓,filename);
lookup(fontchan,filename,flag);
if not flag then print(" *");
end "look for PXL file";
if flag then
begin "Look for TFM file"
! Couldn't find PXL file. Look for TFM file on PPN given in FILENAME,
if any, else on TFMPPN (except when preloading).;
pxl_filename ← filename; ! For error message;
if fontnumber ≠ preloaded then
begin
file_type ← tfm;
filename ← farray[0] & ".TFM" & farray[2];
if farray[2] = "" then filename ← filename & tfmppn;
lookup(fontchan,filename,flag);
if flag then all_done ← true; ! We're going to quit;
end;
end "Look for TFM file";
setformat(0,3);
if file_type = tfm then
begin
print(" Font ",fontname," not found.");
print(" Reading character widths from TFM file." & ↓);
end;
! If we find neither a GF, a PXL nor a TFM file, we return here since
we're never going to get past the postamble.;
if all_done then return;
if fontnumber ≠ preloaded and find_font(fontnumber,true) then
error("Font " & fontnumber & " defined more than once");
flength ← filesize; ! Note that this will have to be corrected later;
! Create a record for the font;
new_font ← new_record(font);
font:fontnumber[new_font] ← fontnumber;
font:filename[new_font] ← filename;
font:length[new_font] ← flength;
font:file_type[new_font] ← file_type;
font:next[new_font] ← current_font;
current_font ← new_font;
if file_type = tfm then go to pre_pre_process;
if file_type = pxl then
begin
! Create an array to hold the font information (SAIL manual, p. 65);
memory[location(font:data[current_font])] ← armak(0,flength-1,1);
arryin(fontchan,font:data[current_font][0],flength);
close(fontchan);
font:bc[current_font] ← 0;
font:ec[current_font] ← 127;
font:dir[current_font] ←flength -517;
font:base[current_font] ←flength -517;
for i ← 0 thru 511 do temp_directory[i] ← 0; ! To handle missing glyphs;
go to pre_pre_process;
end;
for i ← 0 thru 1023 do temp_directory[i] ← 0; ! To handle missing glyphs;
! We will need to bring the data from the fontchan into a temporary array;
begin "hold_data routine"
integer r,s;
integer array hold_data[0:flength-1];
! print(" ready to create array ");
arryin(fontchan,hold_data[0],flength);
! print(" holding array created ");
! Now process the GF information and store it away;
! print(" Ready to process the gf info" & ↓);
gfbc ← 1023; ! Set to the opposite extreme to start;
gfec ← 0;
gf_point ← point(8,hold_data[flength-1],7);
q ← ldb(gf_point);
! print("first gf_point= ",cvos(gf_point)," q= ",q,↓);
while q ≠ 131 do
begin
q←get_gf_prev;
! print("loop gf_point= ",cvos(gf_point)," q= ",q,↓);
end;
q ← get_gf_prev;
q ← get_gf_prev;
q ← get_gf_prev;
q ← get_gf_prev;
k ← gf_word;
! print("This should be a byte address ",cvos(k));
r ← k lsh -2;
! print(" ",cvos(r));
s ←((k-(r lsh 2)) * 8) + 7;
! print(",",cvos(s),↓);
gf_point ← point(8,hold_data[r],s);
q ← gf_byte;
if q ≠ post then print("error reading ",q,↓);
q ← gf_signed_quad;
design_size ← gf_signed_quad;
font_cksum ← gf_signed_quad;
hppp ← gf_signed_quad;
! print(" design size etc ",design_size," ",font_cksum," ",hppp,↓);
q ← gf_signed_quad; ! We ignore this;
min_m ← gf_signed_quad;
max_m ← gf_signed_quad;
min_n ← gf_signed_quad;
max_n ← gf_signed_quad;
words_required ← 0;
q ← gf_byte;
! print(" should be 245 or 246 ",q,↓);
do begin "Process the char locs"
if (q=char_loc) or (q=char_loc+1) then
begin
c←gf_byte;
if c < gfbc then gfbc ← c else
if c > gfec then gfec ← c;
if q=char_loc then
begin
k ← gf_word;
k ← gf_word;
end
else k ← gf_byte;
temp_directory[(c*4)+3] ← gf_signed_quad; ! This is the TFM width;
! print(" ",c," with w=", temp_directory[(c*4)+3]," ");
k ← gf_word; ! This points to the raster details;
saved_ptr ← gf_point;
r ← k lsh -2;
! print(" ",cvos(r));
s ←((k-(r lsh 2)) * 8) + 7;
! print(",",cvos(s));
gf_point ← point(8,hold_data[r],s);
! print(" gf_point = ",cvos(gf_point));
do begin "Skip to next glyph"
q ← gf_byte;
! print(" q= ",q,↓);
case q of begin "Case q"
[xxx1] begin
i ←gf_byte;
while i > 0 do
begin
q ← gf_byte;
i ← i - 1;
end;
q ← no_op;
end;
[no_op] q ← no_op;
[yyy] begin
q ← gf_signed_quad;
q ← no_op;
end
end "Case q";
end "Skip to next glyph"
until q ≠ no_op;
! print(" Should be 67 or 68 ",q,↓);
if (q = boc) or (q = boc1) then
begin "boc or boc1"
if q = boc then
begin
c ← gf_signed_quad;
i ← gf_signed_quad;
min_m ← gf_signed_quad;
max_m ← gf_signed_quad;
min_n ← gf_signed_quad;
max_n ← gf_signed_quad;
del_m ← max_m-min_m;
del_n ← max_n-min_n;
end
else begin
c ← gf_byte;
del_m ← gf_byte;
max_m ← gf_byte;
del_n ← gf_byte;
max_n ← gf_byte;
min_m ← max_m-del_m;
end;
q ← ((del_m + 1 + 31) lsh -5) * (del_n + 1); ! Required raster space;
words_required ← words_required + q;
! print(q," ");
! print(c,"(",q,",",words_required,") ");
q ← no_op;
end "boc or boc1";
! print(" q=",q," ");
gf_point ← saved_ptr;
q ←gf_byte;
end;
end "Process the char locs"
until q = post_post;
dir_space ← (gfec + 1 -gfbc) lsh 2;
! print(" ",gfbc,",",gfec);
! print(" dir_space will be ",dir_space,↓);
flength ← words_required + 6 + dir_space; ! Length of the font file record;
! flength ← words_required + 518; ! Length of the font file record;
! print(" second file_type=",file_type,↓);
! print(" computed flength= ",flength,↓);
font:length[current_font] ← flength; ! The first correction for old value;
! We may have to correct this a second time;
! Create an array to hold the font information (SAIL manual, p. 65);
memory[location(font:data[current_font])] ← armak(0,flength-1,1);
gf_point ← point(8,hold_data[0],7);
q ← gf_byte;
! print("q = ",q , ↓);
if q ≠ 247 then error("GF file does not start with 247");
q ← gf_byte;
! print("q = ",q , ↓);
if q ≠ 131 then error("GF file's ID is not 131");
k← gf_byte;
! print("k = ",k , ↓);
for i ← 1 thru k do q ← gf_byte; ! Pass over introductory remark;
font:data[current_font][0] ← 131 lsh 4;
word_count ← 1;
do begin "save raster information"
do begin "Pass no_op,xxx and yyy"
q ← gf_byte;
if (q = yyy) then begin
q ← gf_word;
q ← no_op;
end
else if (q ≥ xxx1) and (q ≤ xxx1+3) then
begin
i ← gf_byte;
while i > 0 do
begin
q←gf_byte;
i ←i - 1;
end;
q ← no_op;
end;
end "Pass no_op,xxx and yyy"
until q ≠ no_op;
if (q = boc) or (q = boc1) then
begin
if q = boc then
begin
c ← gf_signed_quad;
! print(c," ");
i ← gf_signed_quad;
min_m ← gf_signed_quad;
max_m ← gf_signed_quad;
min_n ← gf_signed_quad;
max_n ← gf_signed_quad;
del_m ← max_m-min_m;
del_n ← max_n-min_n;
end
else begin
c ← gf_byte;
! print(c," ");
del_m ← gf_byte;
max_m ← gf_byte;
del_n ← gf_byte;
max_n ← gf_byte;
min_m ← max_m-del_m;
end;
! temp_directory[c*4] ← ((del_m+1) lsh 16) lor (del_n+1);
temp_directory[c*4] ← ((del_m+1) lsh 16);
! print(" w= ",del_m+1," h= ",del_n+1);
! Width,Height;
temp_directory[(c*4)+1] ← ((((-min_m) lsh 20) lsh - 4) lor max_n);
! print(" X_offset= ",-min_m," Y_offset= ",max_n);
! X-Offset,Y-Offset;
temp_directory[(c*4)+2] ← word_count;
! print(c," word_count= ",temp_directory[c*4+2]);
words_per_row ← (del_m + 32) lsh - 5;
byte_hold ← no_op;
w ← 0;
dis ← 0;
val ← 0;
n ← 0;
while byte_hold ≠ eoc do
begin "while byte_hold ≠ eoc"
while n < words_per_row do
begin "while n < words_per_row"
while dis < 32 do
begin "while dis < 32"
if dis > 0 then val←val+btab[w]-btab[dis];
w ← gf_byte;
if w ≤ paint2 then
begin "if w < paint2"
if w = paint1 then w←gf_byte else
if w = paint2 then w←gf_halfword;
b ← gf_byte;
if b ≤ paint2 then
begin
if b = paint1 then b ← gf_byte else
if b = paint2 then b ← gf_halfword;
end
else
begin
byte_hold ← b;
b ← 0;
w ← 32*words_per_row;
end;
end "if w < paint2"
else
begin "w > paint2"
byte_hold ← w;
b ← 0;
w ← 32*words_per_row;
end "w > paint2";
w ← dis+w;
dis ← w+b;
end "while dis < 32";
if w ≥ 32 then w ← w - 32
else begin
val ← val+btab[w];
w ← 0;
end;
n ← n + 1;
! if n = 1 then print(↓);
! print(cvos(val)," ");
! print(cvos(val)," ",c,"(",n,")", ↓);
font:data[current_font][word_count] ← val lsh 4;
word_count ← word_count +1;
dis ← dis-32;
val ← 0;
end "while n < words_per_row";
if byte_hold = no_op then q ← gf_byte else q ← byte_hold;
if (q≥new_row_0) and (q≤new_row_164) then
begin
w ← q-new_row_0;
b←gf_byte;
if b ≤ paint2 then
begin
if b = paint1 then b ← gf_byte else
if b = paint2 then b ← gf_halfword;
end
else begin
b ← 0;
w ← words_per_row lsh 5;
end;
n ← 0;
dis ← w + b;
val ← 0;
end
else if (q ≥ skip0) and (q < new_row_0) then
begin
if q > skip0 then
begin
q ← gf_byte;
while q > 0 do
begin
for n ←1 thru words_per_row do
begin
! if n = 1 then print(↓);
! print(0," ");
font:data[current_font][word_count] ← 0;
word_count ← word_count +1;
end;
! print(0 ,↓);
q ← q - 1;
end;
end;
n ← 0; dis ← 0; val ← 0; w ← 0; b ← 0;
end;
end;
end;
k ← (word_count - temp_directory[(c*4)+2]) div words_per_row;
! print(" k= ",k,↓);
temp_directory[c*4]←(temp_directory[c*4]) lor k;
! print(" ",word_count,↓);
end "save raster information"
until q=post;
end "hold_data routine";
! print(↓,"At post with word_count of ",word_count, ↓);
q←word_count;
dir_space ← (gfec + 1 - gfbc) lsh 2;
dir_base ← q - (gfbc lsh 2);
! print("flength= ",flength," and need ",q+517,↓);
! print(" when activated we will need ",q+dir_space+5,↓);
! print(" dir_base will be ",dir_base);
! print(" font:dir ",q,↓);
! print(" gfbc will be ",gfbc);
! print(" gfec will be ",gfec,↓);
! if flength > q + 517 then flength ← q + 517; ! This may be needed;
if flength > (q + 5 + dir_space) then flength ← q + 5 + dir_space;
font:length[new_font] ← flength;
font:base[new_font] ← dir_base;
font:dir[new_font] ← q;
font:bc[new_font] ← gfbc;
font:ec[new_font] ← gfec;
! current_font_size ← gfec + 1 - gfbc;
! print(" c_f_size at L 555 = ",current_font_size,↓);
! for i ← 0 thru 511 do;
! for i ← 0 thru (gfec lsh 2) + 3 do;
for i ← (gfbc lsh 2) thru (gfec lsh 2) + 3 do
begin
font:data[current_font][word_count] ← temp_directory[i] lsh 4;
word_count ← word_count +1;
end;
! for c← bc thru ec do
! begin "Show directory"
! print(↓,c," ");
! for i←0 thru 1 do
! begin
! print( " ",temp_directory[4*c+i] lsh -16);
! print( " ",(temp_directory[4*c+i] lsh 20) lsh -20);
! end;
! for i←2 thru 3 do print( " ",temp_directory[4*c+i]);
! end "Show directory";
! print(↓);
font:data[current_font][word_count] ← font_cksum lsh 4;
word_count ← word_count +1;
font:data[current_font][word_count] ← extension lsh 4;
word_count ← word_count +1;
font:data[current_font][word_count] ← design_size lsh 4;
word_count ← word_count +1;
font:data[current_font][word_count] ← q lsh 4;
word_count ← word_count +1;
font:data[current_font][word_count] ← 131 lsh 4;
word_count ← word_count +1;
! For i←0 thru 20 do
! begin
! for j←0 thru 4 do
! begin
! k←font:data[current_font][5*i+j] lsh -4;
! print(cvos(k)," ");
! end;
! print(↓);
! end;
! For i←0 thru 20 do print(font:data[current_font][i] lsh -4,↓);
! print(font:data[current_font][flength-5] lsh -4," ");
! print(font:data[current_font][flength-4] lsh -4," ");
! print(font:data[current_font][flength-3] lsh -4," ");
! print(font:data[current_font][flength-2] lsh -4," ");
! print(font:data[current_font][flength-1] lsh -4,↓);
pre_pre_process:
! print(" file_type=",file_type,↓);
if file_type = tfm then
begin
memory[location(font:data[current_font])] ← armak(0,flength-1,1);
arryin(fontchan,font:data[current_font][0],flength);
end;
close(fontchan);
current_font_ptr ← location(font:data[current_font][0]);
! print("current_font_ptr after readin ",current_font_ptr,↓);
! Unfortunately we cannot preprocess preloaded fonts, since UNITSCALE is
not defined at that time. So preprocessing will be done when the font
is actually used.;
if fontnumber = preloaded then return;
pre_process:
if (file_type = gf) or (file_type = pxl) then
begin "preprocessing"
! Compute the multiplier for this font;
fmult ← (font:data[current_font][flength-3] ash -4) ! design size in fixes;
* mag * (2.54*100000.) / (2.0↑40*72.27*unitscale);
! Do the preprocessing on the font data;
current_font_base ← current_font_ptr + font:base[current_font];
current_font_bc ← font:bc[current_font];
current_font_ec ← font:ec[current_font];
! print(" current_font_ptr at 635 preprocessing ",current_font_ptr,↓);
current_font_data ← current_font_ptr + font:dir[current_font];
current_font_size ← current_font_ec + 1 - current_font_bc;
! print(" current_font_data at 639 preprocessing ",current_font_data,↓);
! print(" current_font_size at pre = ",current_font_size,↓);
start_code "convert"
define a=1, b=2, x=3, y=4;
label loop;
movei a,128; ! Number of characters left to do;
move a,current_font_size; ! Number of characters left to do;
move b,current_font_data; ! Addr of 1st word of current char;
loop: move x,0(b);
move y,x;
ash x,-20; ! X ← pixel width;
lsh y,16;
ash y,-20; ! Y ← pixel height;
hrl y,x; ! Merge into Y;
movem y,0(b); ! Store it away;
move x,1(b);
move y,x;
ash x,-20; ! X ← x offset;
lsh y,16;
ash y,-20; ! Y ← y offset;
hrl y,x; ! Merge into Y;
movem y,1(b); ! Store it away;
move x,2(b);
ash x,-4; ! X ← character starting word in DATA;
movem x,2(b); ! Store it;
move x,3(b);
ash x,-4; ! X ← character width in FIXes;
fltr x,x; ! Multiply by FMULT in floating point;
fmpr x,fmult;
fixr x,x; ! X ← character width in RSUs;
movem x,3(b); ! Store it;
addi b,4; ! Index for next character;
sojg a,loop; ! See if we're done;
end "convert";
font_cksum ← font:data[current_font][flength-5] lsh -4;
! print(" 770 cksum ", font_cksum," flength ",flength," ");
end "preprocessing"
else if file_type = tfm then
begin "tfm preprocessing"
! The only interesting information in the TFM file is the character
widths. After the following preprocessing is done, word 0 of the data
array will contain LH, word 1 will contain BC, word 2 will contain EC,
and words 6+LH through 6+LH+(EC-BC) will contain the widths of
characters BC through EC, in rsu's. (See the description of TFM files
for the definition of all the 2-letter variables used here.);
fmult ← (font:data[current_font][7] ash -4) ! design size in fixes;
* mag * (2.54*100000.) / (2.0↑40*72.27*unitscale);
start_code "convert"
define a=1, b=2, c=3, d=4, x=5;
label loop;
movsi a,'242000;
add a,current_font_ptr; ! Byte ptr to LF;
ildb b,a; ! B ← LH;
ildb c,a; ! C ← BC;
ildb d,a; ! D ← EC;
move a,current_font_ptr;
movem b,0(a);
movem c,1(a);
movem d,2(a);
addi a,6(b); ! A ← ptr to start of char_info;
move b,a;
addi b,1(d);
sub b,c; ! B ← ptr to start of widths;
subi c,1(d);
hrl a,c; ! set up for AOBJN;
loop: move x,0(a); ! char_info word;
lsh x,-28; ! width index;
add x,b;
move x,0(x); ! word from width table;
ash x,-4; ! X ← character width in FIXes;
fltr x,x; ! Multiply by FMULT in floating point;
fmpr x,fmult;
fixr x,x; ! X ← character width in RSUs;
movem x,0(a); ! Store it;
aobjn a,loop;
end "convert";
font_cksum ← font:data[current_font][6] lsh -4; ! header[0];
end "tfm preprocessing";
! Verify the font checksum, unless not required to;
if cksum and font_cksum and (cksum ≠ font_cksum) then
print("Checksum mismatch for font ",filename," ",cksum,",",font_cksum,↓);
end "read_font_file";
! PRELOAD_FONTS reads in font files and sets up the core image to be saved, so
that this doesn't have to be done every time the program is run.;
simple procedure preload_fonts;
begin "preload_fonts"
define num_fonts = 17;
preload_with "MANFNT","AMR10","AMR9","AMR8","AMR7","AMR5","AMMI10","AMMI7",
"AMMI5","AMSY10","AMSY7","AMSY5","AMEX10","AMTI10","AMSL10",
"AMBX10","AMTT10";
saf own string array font_name[1:num_fonts];
integer i;
magnification ← default_mag;
! print("in ");
btab[0] ← (1 lsh 32)-1; ! Set up GF to PXL translation table;
! print(cvos(btab[0]),↓);
for i ← 1 thru 32 do btab[i] ← btab[i-1] lsh -1;
open(fontchan←getchan,"dsk",'17,0,0,0,brchar,eof);
for i ← 1 thru num_fonts do begin "preload a font"
print("Preloading ",font_name[i],↓);
! All fonts currently preloaded are at magnification 1.0 * default_mag;
read_font_file(preloaded,font_name[i],1.0,0);
end "preload a font";
print(if all_done then "
Something went wrong. Please fix things and try again.
" else "
Ready to save the core image.
");
magnification ← 0;
release(fontchan);
if not all_done then ptostr(0,"save dvidd[mf,als]");
end "preload_fonts";
Comment POSTAMBLE processes the postamble of the DVI file, reading in the fonts
requested.;
procedure postamble;
begin "postamble"
integer byte,i,fontnumber,postambleptr,area_length,name_length;
integer dvi_mag,dvicmd,fcksum,extension;
real fmag;
string area,s;
define FNTDEF1={243}, FNTDEF2={244}, FNTDEF3={245}, FNTDEF4={246},
POST_POST={249}; ! for version 2;
! Verify that we are looking at a DVI file, and find the postamble pointer.;
setpos(dvilength*4); ! Go to the last byte;
byte ← 0;
while byte = 0 do byte ← getprev; ! Skip filling nulls;
for i ← 1 thru 4 do begin
if byte ≠ 223 then error("Bad DVI format: Missing postamble");
byte ← getprev
end;
while byte = 223 do byte ← getprev;
dvi_version ← byte;
if not (1 ≤ dvi_version ≤ 2) then
error("Sorry, only version 1 or 2 DVI files accepted. Yours is version "
& (dvi_version + "0"));
postambleptr ← 0;
for i ← 1 thru 4 do postambleptr ← (postambleptr rot -8) lor getprev;
postambleptr ← (postambleptr rot -8) ash -4;
setpos(postambleptr);
if getnext ≠ pst[dvi_version] then
error("Bad DVI format: Misplaced postamble");
! First six PST parameters are the same for versions 1 and 2;
lastpageptr ← getint;
unitscale ← getint;
unitscale ← unitscale/getint; ! num and denom of units ratio;
dvi_mag ← getint;
if magnification = 0 then magnification ← dvi_mag;
conv ← magnification*PixelsPerRSU*unitscale/1000.0;
! The maximum height and width will allow us to compute number of rows and
the number of words per row in the PAGEBUF array.;
max_vv ← getint * conv + .5; ! round up;
max_hh ← getint * conv + .5; ! here too;
left_hh ← - extra_cols;
right_hh ← (max_hh + 31) land (lnot 31) + extra_cols - 1;
row_size ← (right_hh-left_hh+1) lsh -5;
top_vv ← - extra_rows;
bottom_vv ← max_vv + extra_rows;
! Make sure dimensions are reasonable. Otherwise, SAIL runtimes will
generate obscure errors.;
if row_size * (bottom_vv - top_vv + 1) > 100000 ! fairly randomly chosen;
! if row_size * (bottom_vv - top_vv + 1) > 150000 ! fairly randomly chosen;
then begin "too big"
integer ch;
print("This DVI file has an enormous maximum page " &
(if bottom_vv - top_vv > 2500 then "height" else "width") &
". It may cause strange errors" & ↓ &
"or not display correctly. Type Y to continue: ");
if (ch ← inchrw) ≠ "Y" and ch ≠ "y" then exit(0)
else print(↓);
end "too big";
if dvi_version = 1 then begin "version 1 font definitions"
while (fontnumber ← getint) ≠ -1 do begin
s ← "";
fcksum ← bites4; ! get font checksum;
fmag ← getint/1000.0; ! get font magnification;
name_length ← getnext;
for i ← 1 thru name_length do s ← s & getnext;
read_font_file(fontnumber,s,fmag,fcksum);
end;
end "version 1 font definitions"
else if dvi_version = 2 then begin "version 2 font definitions"
! First, we read a couple more parameters that are present in version 2;
stack_depth ← twobites;
num_pages ← twobites;
while (dvicmd ← getnext) ≠ POST_POST do begin
if dvicmd = FNTDEF1 then fontnumber ← getnext
else if dvicmd = FNTDEF2 then fontnumber ← bites2
else if dvicmd = FNTDEF3 then fontnumber ← bites3
else if dvicmd = FNTDEF4 then fontnumber ← getint
else error("Bad DVI format: unexpected command (" & cvs(dvicmd)
& ") in postamble");
area ← s ← "";
fcksum ← bites4; ! get font checksum;
fmag ← getint; ! ``at size'' in scaled points;
fmag ← fmag/getint; ! divide by design size;
area_length ← getnext;
name_length ← getnext;
for i ← 1 thru area_length do area ← area & getnext;
for i ← 1 thru name_length do s ← s & getnext;
s ← s & area;
read_font_file(fontnumber,s,fmag,fcksum);
end;
end "version 2 font definitions";
if all_done then error("I can't proceed without all needed fonts");
end "postamble";
Comment Page number handling: FIND_PAGES, GO_TO_PAGE;
! PAGE_LIST is a record class for the list of page addresses. FIRST_PAGE
will point to the beginning of a linked list of these records.;
record_class page_list (
record_pointer(page_list) next; ! Next page;
integer start; ! Starting byte address;
boolean warned ! TRUE if we've printed a "character
off page" message;
);
record_pointer(page_list) first_page;
integer current_page; ! The page we are on now;
integer number_of_pages; ! Total number of pages in DVI file;
! FIND_PAGES follows the previous page pointers in the DVI file, to build
up a list of the starting point of each page. This will allow us to get
to any page quickly.;
procedure find_pages;
begin "find_pages"
integer page_ptr,i;
record_pointer(page_list) new_page;
first_page ← null_record;
page_ptr ← lastpageptr;
number_of_pages ← 0;
while page_ptr ≥ 0 do begin
setpos(page_ptr);
number_of_pages ← number_of_pages + 1;
new_page ← new_record(page_list);
page_list:start[new_page] ← page_ptr;
page_list:next[new_page] ← first_page;
first_page ← new_page;
if getnext ≠ BOP[dvi_version] then
error("Page pointer not to beginning of page");
for i ← 1 thru 10 do getint; ! Skip counter values;
page_ptr ← getint; ! Previous page pointer;
end;
end "find_pages";
! GO_TO_PAGE sets the position in the DVI file to a specified page number.
The page number is assumed to be in range.;
procedure go_to_page(integer p);
begin "go_to_page"
record_pointer(page_list) page;
page ← first_page;
while p > 1 do begin
page ← page_list:next[page];
p ← p - 1;
end;
setpos(page_list:start[page]);
end "go_to_page";
Comment MAKE_PEN constructs a pen polygon for use with SET_VECTOR
Pens are stored in fixed arrays because their space requirements
are so modest;
! The following kludge allows compile time arithmetic to use floating point.
It takes a positive floating point number that Sail believes is an integer,
and converts it into a true integer;
define ct_floor(x) = {(((x) land '777777777) ash (((x) lsh -27)-(128+27)))};
! Now compute compile time constants max_pen_v, the number of vertices in
half of a pen polygon, and max_pen_s, a stack size parameter. Both of
these depend on aspect and max_pen_size;
define max_perimeter_over_pi = {.75 + aspect*max_pen_size*(1-.25*(1-1/aspect↑2) )};
define real_max_pen_v = 2.768*(1/3.14159 + max_perimeter_over_pi)↑(2/3) + 3.44;
define max_pen_v = ct_floor(real_max_pen_v);
define real_pen_s_break = 1 + (max_pen_size/aspect)↑(1/3);
define pen_s_break = ct_floor(real_pen_s_break);
define real_max_pen_s = pen_s_break + 1.5 +
max_pen_size/(1.0 max 2*pen_s_break*(pen_s_break-1)*aspect);
define max_pen_s = ct_floor(real_max_pen_s);
real cur_pen_size; ! as in DVI file or -1 if uninitialized;
integer pen_v; ! number of vertices in current pen;
saf integer array cur_pen[1:max_pen_v]; ! Vertices of current pen;
simple procedure pen_init;
cur_pen_size ← -1.0;
require pen_init initialization;
! During construction, the pen polygon (or rather one octant of it) is stored
in a stack of records implemented with parallel arrays. Each record gives
the coordinates of a vertex, the relative length of its left and right
edges, and the direction and class of the right neighbor edge. The
direction and class of the left neighbor edge for the vertex at the top of
the stack are kept in global variables;
define cur_xy = {xy_arr[poly_sp]};
define cur_llength = {llength_arr[poly_sp]};
define cur_rlength = {rlength_arr[poly_sp]};
define rt_uv = {uv_arr[poly_sp]};
define rt_class = {class_arr[poly_sp]};
define rt_xy = {xy_arr[poly_sp-1]};
define rt_llength = {llength_arr[poly_sp-1]};
define rt_rlength = {rlength_arr[poly_sp-1]};
integer lft_uv, lft_class;
integer poly_sp;
saf own integer array xy_arr, llength_arr,
rlength_arr, uv_arr, class_arr[0:max_pen_s];
! We store (u,v) or (x,y) pairs in one word with the first component in
the left half-word and the second in the right half-word. This is
simplified by the fact that v is never negative. The computed pen will
be a list of (x,y) pairs giving the right side pen vertices in multiples
of 1/2 pixel;
define pack_pair(x,y) = {(((x) lsh 18) + (y))};
simple integer procedure length_sqr(integer uv);
quick_code
HLRE '13, uv; ! Get u (which could be negative);
HRRZ 1, uv; ! Get v (which is positive or zero);
IMUL '13, '13; ! Square u;
IMUL 1, 1; ! Square v;
ADD 1, '13; ! Return u↑2 + v↑2;
end;
! Compute c↑2 where c is such that v*x-u*y=c is a tangent line to the
ellipse x↑2 + (y/aspect)↑2 = 1;
simple real procedure class_factor_sqr(integer uv);
quick_code
HLRE '13, uv; ! Get u (which could be negative);
HRRZ 1, uv; ! Get v (which is positive or zero);
IMUL '13, '13; ! Square u;
FLTR '13, '13;
FMPR '13, [aspect↑2]; ! u↑2 * aspect↑2;
IMUL 1, 1; ! Square v;
FLTR 1, 1;
FADR 1, '13; ! Return aspect↑2*u↑2 + v↑2;
end;
simple integer procedure dotprod(integer uv, xy);
quick_code;
define x=1, y='14, u='13, v='15;
HLRE x, xy; ! Get x;
HRRE y, xy; ! Get y;
TLNE y, '400000; ! Is y positive?;
ADDI x, 1; ! No. Correct x;
HLRE u, uv; ! Get u;
IMUL x, '13; ! Find x*u;
HRRZ v, uv; ! Get v;
IMUL v, y; ! Find y*v;
ADD x, v; ! Return x*u + y*v;
end;
! The output buffer is a list of (x,y) pairs describing the first octant
of the pen polygon;
define init_cur_pen = {pen_v ← 0};
define no_vertices_out = {(pen_v = 0)};
define vertex_out(xy) = {cur_pen[pen_v←pen_v+1] ← xy};
! The following routine is simple except for the magical expressions that
rotate pairs. We add a reflected copy of the given quadrant to obtain the
entire right half of a pen polygon, avoiding duplicate vertices;
simple procedure dup_quadrant;
begin "duplicate quadrant"
integer i, lim;
lim ← if cur_pen[pen_v] land '777777 then pen_v else pen_v-1;
if pen_v+lim>max_pen_v then error("Too many pen vertices!"); ! can't happen;
for i ← lim downto 1
do vertex_out(cur_pen[i] + '777777 xor '777777);
end "duplicate quadrant";
! Here is a system for marking vertices that uses the fact that x>0. We
must check for the mark and unmark the vertex before using it;
define mark_right_vertex = {rt_xy ← -abs(rt_xy)};
define vertex_marked = {(cur_xy < -'400000)};
define unmark_vertex = {cur_xy ← abs(cur_xy)};
procedure make_pen(real size_in_pen_units);
begin "make pen"
real diameter; ! diameter in pixels;
integer uv, uv_sqr, class; ! data for edge being added;
integer xy; ! coordinates current vertex;
integer tot_class; ! new class number for stack-top vertex;
integer delta; ! number of classes to cut off;
integer old_llength; ! temporary for updating polygon;
diameter ← size_in_pen_units * PenUnitScale * conv;
diameter ← .5 max diameter min max_pen_size;
init_cur_pen;
lft_uv ← pack_pair(1,0);
lft_class ← diameter*aspect;
class ← diameter;
poly_sp ← 1;
cur_xy ← pack_pair(class, -lft_class);
cur_llength ← class;
cur_rlength ← lft_class;
rt_uv ← pack_pair(0,1);
rt_class ← class;
rt_llength ← 1; ! Anything positive would do here;
do begin "main loop"
if vertex_marked then begin unmark_vertex; delta←0; end
else delta ← cur_llength min cur_rlength;
if delta>0 then
begin uv ← lft_uv + rt_uv;
class ← diameter * sqrt(class_factor_sqr(uv));
tot_class ← lft_class + rt_class;
delta ← (tot_class - class) min delta;
end;
if delta≤0 then
begin vertex_out(cur_xy);
lft_uv ← rt_uv;
lft_class ← rt_class;
rt_llength ← rt_llength + cur_rlength;
poly_sp ← poly_sp-1;
continue "main loop";
end;
if delta=cur_llength then
begin lft_uv ← uv;
if no_vertices_out then vertex_out(pack_pair(0,-lft_class));
lft_class ← tot_class - delta;
if cur_rlength + rt_llength = delta then poly_sp ← poly_sp-1
else begin
cur_rlength ← cur_rlength - delta;
cur_xy ← cur_xy + delta*rt_uv;
cur_llength ← delta;
end;
end
else begin
xy ← cur_xy;
old_llength ← cur_llength;
if cur_rlength + rt_llength = delta then mark_right_vertex
else begin cur_rlength ← cur_rlength - delta;
cur_xy ← xy + delta*rt_uv;
if (poly_sp ← poly_sp+1) > max_pen_s
then error("Pen stack overflow!"); ! can't happen;
if rt_rlength=0 then rt_llength ← 0
else begin
uv_sqr ← length_sqr(uv);
rt_llength ← 0 max
(dotprod(uv, rt_xy) + uv_sqr ash -1) div uv_sqr min delta;
end;
end;
cur_rlength ← delta - rt_llength;
cur_llength ← old_llength - delta;
cur_xy ← xy - delta*lft_uv;
rt_uv ← uv;
rt_class ← tot_class - delta;
end;
end "main loop"
until poly_sp = 0;
dup_quadrant;
cur_pen_size ← size_in_pen_units;
end "make pen";
Comment WORK does the main processing of the DVI file;
procedure work;
begin "work"
! PAGEBUF holds the raster image of an entire page. It is declared here
so that its size may depend on information gotten from the postamble.;
saf integer array pagebuf[top_vv : bottom_vv, left_hh div 32 : right_hh div 32];
! DDBUF is an array which will contain the actual DataDisc program. The
first two words, DDBUF[-2] and DDBUF[-1], hold the arguments to the DDUPG
UUO. The rest hold the command words and graphics words of the program.;
define begx = '10; ! First pixel to use in X-direction;
define begy = 36; ! First pixel to use in Y-direction;
define xsize = 500; ! Number of pixels in X-direction;
define ysize = 380; ! Number of pixels in Y-direction
(should be a multiple of 4);
define xwords = (xsize+31) div 32;
! Number of words per row in DD program (32 bits per word);
saf integer array ddbuf[-2:3+(2+xwords)*ysize];
! DDBUF does not contain the rows of the screen in order, because the DD
controller needs to receive rows 0,4,8,..., then 1,5,9,..., then
2,6,10,..., then 3,7,11,.... Therefore, ROWTAB is set up as an array of
pointers to the beginning of each row in DDBUF.;
saf integer array rowtab[0:ysize-1];
! TEXTBUF is used to hold a DD program for displaying text lines.;
saf integer array textbuf[-4:300];
! The following integers describe what is being shown on the display;
integer num_rows;
integer num_cols;
integer top_row;
integer bottom_row;
integer left_col;
integer right_col;
! POINT_H and POINT_V hold coordinates for the 256 "point" registers
used by \special graphics commands.;
define highest_point = 255;
integer array point_h[0:highest_point], point_v[0:highest_point];
Comment INIT_DDBUF handles initialization of DDBUF that has to be done only once
in the program. Some of this code was adapted from DDFONT.SAI[CSP,SYS].;
procedure init_ddbuf;
begin "init_ddbuf"
integer i,j,k,ptr,chanwd,cwd,p1,p2;
! Here we initialize DDBUF and ROWTAB. Each row of DDBUF begins with two
command words. The first word in the first row sets the function code
register and the line number. The first word in other rows does an
execute and sets the line number. The second word in each row sets the
beginning column number. The rest of the words in DDBUF are initially
set to 2, i.e. an empty graphics word.;
chanwd ← '002004003324;
dpb(ddchan land '77,point(8,chanwd,23));
dpb((begx+7)%8,point(7,chanwd,15));
ptr ← point(36,ddbuf[0],-1);
cwd ← '116000001454;
p1 ← point(4,cwd,23);
p2 ← point(5,cwd,15);
for i ← 0 thru 3 do
for j ← i step 4 until ysize-1 do begin
dpb(begy+j,p1);
dpb((begy+j) lsh -4,p2);
idpb(cwd,ptr);
idpb(chanwd,ptr);
cwd ← '454;
rowtab[j] ← (ptr land '777777)+1;
! The following loop may be replaced with a simple addition to PTR now that
we use BLANK_DDBUF at the beginning of each page.;
quick_code
label loop;
movei '13,2;
movei '14,xwords;
loop: idpb '13,ptr;
sojg '14,loop
end
end;
idpb('000004010334,ptr);
idpb(0,ptr);
ddbuf[-1] ← ptr land '777777-location(ddbuf[0]);
ddbuf[-2] ← location(ddbuf[0]);
end "init_ddbuf";
Comment HELP_MESSAGE summarizes the commands to this program.;
simple procedure help_message;
begin "help_message"
! First we clear the screen.;
break("P");
call(0,"sleep");
call(0,"sleep");
call(0,"sleep"); ! Hopefully, the display has cleared by now;
! Now we set up the text and display it. Note that there should not
be any tabs in the text sent to the Data Disc. I've split the string
into pieces, so the SAIL compiler doesn't run out of string space.;
init_text(textbuf,"
Commands in DVIDD are similar (as much as possible) to those of E. Here is a
partial list. (The full list can be found in the file DVIDD.JJW[UP,DOC]). In
the commands below, ""#"" is any string of digits.
<form> Go forward (about 3/4 of a screenful)
<vt> Go back (about 3/4 of a screenful)
← Move text left (about 3/4 of a screenful)
→ Move text right (about 3/4 of a screenful)
` Move text left (about 1/16 of a screenful)
' Move text right (about 1/16 of a screenful)
B Glitch screen up from bottom
E Exit from the program" & "
L Go to the top of the page
∞L Go to the bottom of the page
P Go to the next page
+P Go to the next page
-P Go to the previous page
#P Go to page #
+#P Go forward # pages
-#P Go back # pages
T Glitch screen down from top
V Refresh display
βV Clear and refresh display
<alt> Abort partially typed command
ε Edit a file with E
} Run DVIdover to print current file (must not have α bit)
# Run DVIrover to print current file (must not have α bit)
π Run BOISE to print current file (must not have α bit)
@ Rrun DVIesp to print current file (must not have α bit)
<Control> and <meta> are optional, except where shown as α and β.
[Commands not listed above: #<form>, 0<form>, α<form>, #<vt>, 0<vt>, α<vt>,
#B, #L, #T, λ, β}, and ?]
Use the V command to get back to your display from here.
");
quick_code
ddupg @textbuf
end;
end "help_message";
Comment DO_OUTPUT displays a portion of the lines in PAGEBUF, determined by
the values of the variables that delimit the region being shown. The
amount of data shown is always NUM_ROWS rows with NUM_COLS words in each
row (i.e. 32*NUM_COLS bits in each row).;
procedure do_output;
begin "do_output"
integer top_percent,bottom_percent,first_word;
! preload_with [xwords] 2;
! safe own integer array blank_row[0:xwords-1];
! Select pp1, and position the page printer;
quick_code
ppsel 1;
dpypos '777115;
dpysiz '3001;
end;
! Create the text lines at the top and bottom of the screen;
top_percent ← top_row * 100 / max_vv;
bottom_percent ← bottom_row * 100 / max_vv;
setformat(0,3);
init_text(textbuf,
! Header line;
(if top_row ≤ lowest_vv then "******* "
else "...." & cvs(top_percent) & "%....") &
"PAGE " & cvs(current_page) &
" " & dvi_farray[0] & dvi_farray[1] & dvi_farray[2] &
(if top_row ≤ lowest_vv then " *******" else "....") &
! Skip lines to the bottom;
forc iii ← 1 stepc 1 untilc 33 doc {↓ &} endc
! Trailer line;
(if bottom_row ≥ highest_vv then "***** "
else "....." & cvs(bottom_percent) & "%.....") &
"Page " & cvs(current_page) & " of " & cvs(number_of_pages) &
(if bottom_row ≥ highest_vv then " ***** " else ".....") &
"Magnification" & cvf(magnification/1000) & ↓);
! Copy the appropriate words from PAGEBUF to DDBUF.;
first_word ← location(pagebuf[top_row,left_col]);
start_code
define a=1, b=2, c=3, d=4, x=7, y='10, xwords_1=xwords-1;
label loop,loop2,endloop;
move a,first_word;
move b,rowtab; ! B ← addr of rowtab[0];
move c,num_cols;
subi c,1;
move d,num_rows;
loop: hrlz x,a; ! first word of source row;
hrr x,0(b); ! first word of dest row;
hrrz y,x; ! compute last word of dest;
add y,c;
blt x,0(y); ! do the transfer;
add a,row_size; ! increment pointers;
addi b,1;
sojg d,loop;
! ! Blank out rows at the bottom if the screen hasn't been filled;
! move d,num_rows;
! loop2: cail d,ysize;
! jrst endloop;
! hrlzi x,blank_row[0];
! hrr x,0(b);
! hrrzi y,xwords_1(x);
! blt x,0(y);
! addi b,1;
! aoja d,loop2;
endloop: end;
! Execute the DataDisc programs;
quick_code
ddupg @textbuf;
ddupg @ddbuf;
end;
end "do_output";
Comment BLANK_DDBUF fills all graphics words in the DDBUF array with blank
graphics words. This is done whenever we begin to display a page, because
the previous page displayed may have put stuff outside the boundaries of
the current page.;
simple procedure blank_ddbuf;
begin "blank_ddbuf"
preload_with [xwords] 2;
safe own integer array blank_row[0:xwords-1];
start_code
define a=1, b=2, x=3, y=4, xwords_1=xwords-1;
label loop;
movei a,ysize; ! Number of rows to blank;
move b,rowtab; ! B ← address of ROWTAB[0];
loop: hrlzi x,blank_row[0];
hrr x,0(b);
hrrzi y,xwords_1(x);
blt x,0(y);
addi b,1;
sojg a,loop;
end;
end "blank_ddbuf";
Comment SET_CHAR writes a character. Before calling it, HH and VV must be
set to the position of the reference point. The returned value is the
width of the character, in rsu's.;
simple integer procedure set_char(integer char);
begin "set_char"
integer info_start,pxl_width,pxl_height,xoff,yoff,char_start,rsu_width;
integer i,j,char_row_words,page_word,shift_amt;
integer rownum,colnum,hhh,vvv;
label end_set_char;
if current_font = null_record then error("No font defined");
! If we only have a TFM file, we just return the width.;
if current_font_type = tfm then begin "tfm character"
integer lh,bc,ec;
lh ← memory[current_font_ptr];
bc ← memory[current_font_ptr+1];
ec ← memory[current_font_ptr+2];
return(if bc ≤ char ≤ ec then memory[current_font_ptr+6+lh+char-bc]
else 0);
end "tfm character";
! When this program was first written, no preprocessing of the font
information was done, and on a file of character text, over 60% of the
program's time was spent in SET_CHAR. More than half of that time was
spent outside the loop (below) which actually alters PAGEBUF, so in
addition to preprocessing the data, we gain speed by using machine
code in the initialization part of SET_CHAR.;
! Get character information from font directory. The following statements:
!
! info_start ← font:length[current_font] - 517 + 4*char;
! pxl_width ← font:data[current_font][info_start] ash -20;
! pxl_height ← font:data[current_font][info_start] lsh 16 ash -20;
! xoff ← font:data[current_font][info_start+1] ash -20;
! yoff ← font:data[current_font][info_start+1] lsh 16 ash -20;
! char_start ← font:data[current_font][info_start+2] ash -4;
! rsu_width ← (font:data[current_font][info_start+3] ash -4)
! * font:fmult[current_font];
!
! cause a lot of unnecessary code to be generated, so instead we do: ;
! info_start ← current_font_data + (char lsh 2);
! pxl_width ← memory[info_start] ash -20;
! pxl_height ← memory[info_start] lsh 16 ash -20;
! xoff ← memory[info_start+1] ash -20;
! yoff ← memory[info_start+1] lsh 16 ash -20;
! char_start ← memory[info_start+2] ash -4;
! rsu_width ← (memory[info_start+3] ash -4) * current_fmult;
If (char < current_font_bc) or (char > current_font_ec) then return(0);
! A safety measure since we only save data for the range bc thru ec;
start_code
define a=1, x=2;
move a,char;
lsh a,2;
! add a,current_font_data;! A ← addr of 1st word for CHAR;
add a,current_font_base;! A ← reference addr for CHAR 0;
move x,0(a); ! X ← width,,height;
hlrem x,pxl_width;
hrrem x,pxl_height;
move x,1(a); ! X ← x offset,,y offset;
hlrem x,xoff;
hrrem x,yoff;
move x,2(a); ! X ← character start;
movem x,char_start;
move x,3(a); ! X ← width in RSUs;
movem x,rsu_width;
end;
if pxl_height = 0 or pxl_width = 0 then return(rsu_width);
vv ← v * conv; ! fix this;
! If the character would lie partly or wholly off the page, we avoid
writing it.;
if (hhh ← hh-xoff) < left_hh
or (vvv ← vv-yoff) < top_vv
or hhh + pxl_width > right_hh
or vvv + pxl_height > bottom_vv
then begin
page_warn(<"Character '" & cvos(char),"(",char_str(char),
") off page." & ↓>);
go to end_set_char
end;
lowest_hh ← lowest_hh min hhh;
highest_hh ← highest_hh max (hhh+pxl_width);
lowest_vv ← lowest_vv min vvv;
highest_vv ← highest_vv max (vvv+pxl_height);
char_row_words ← (pxl_width + 31) lsh -5;
! Set PAGE_WORD to the word where the upper left pixel of the character
will go.;
page_word ← location(pagebuf[vvv, hhh ash -5]);
shift_amt ← 32 - (hhh land 31);
! Loop to OR the bits of the character into the page.;
start_code
define a=1, b=2, c=3, d=4, e=5, f=6, x='13, y='14;
label loop1, loop2, donerow;
move d,shift_amt; ! D stays constant;
move e,page_word; ! E is addr of first word written in
the current row;
move f,pxl_height; ! F is rows left to do;
move b,current_font_ptr;
add b,char_start; ! B is current word in character;
loop1: move c,e; ! C is current word to write;
move a,char_row_words; ! A is words left to do in this row;
loop2: movei x,0;
move y,0(b); ! Get a piece of the character;
lshc x,0(d); ! Shift it into X and Y;
lsh x,4; ! Always use left 32 bits;
iorm x,0(c); ! OR it into the page;
iorm y,1(c);
aos b; ! Move to next word in character;
sojle a,donerow; ! All done this row?;
aoja c,loop2; ! Nope.;
donerow:add e,row_size; ! Yes, go to next row;
sojg f,loop1; ! Unless we're all done;
end;
end_set_char:
return(rsu_width);
end "set_char";
Comment SET_RULE outputs a rule. H and V are the reference point, and
HEIGHT and WIDTH are the height and width. All measurements are in
pixels.;
simple procedure set_rule(integer h,v,height,width);
begin "set_rule"
integer first_row,num_rows,num_cols,first_word,shift_amt1,shift_amt2;
! We refuse to set rules whose reference point is out of range;
if not ((left_hh ≤ h ≤ right_hh) and
(top_vv ≤ v ≤ bottom_vv)) then return;
first_row ← (v-height+1) max top_vv;
if (num_rows ← v - first_row + 1) = 0 then return;
if (num_cols ← (h+width min right_hh+1) - h) = 0 then return;
lowest_hh ← lowest_hh min h;
highest_hh ← highest_hh max (h+num_cols-1);
lowest_vv ← lowest_vv min first_row;
highest_vv ← highest_vv max v;
first_word ← location(pagebuf[first_row, h ash -5]);
while num_cols > 0 do begin "one column of words"
! In this loop, we handle one column of words, starting at FIRST_WORD.;
! SHIFT_AMT1 is 32 minus the number of 1 bits per word in this column.;
shift_amt1 ← (32-num_cols) max (h land 31);
! SHIFT_AMT2 is an amount needed to get the mask in the proper position.;
shift_amt2 ← shift_amt1 - (h land 31);
start_code
define a=1, b=2, c=3, d=4;
label loop;
seto a,; ! A ← all 1's;
movn b,shift_amt1;
lsh a,0(b); ! Shift right by SHIFT_AMT1;
trz a,'17; ! Set right 4 bits to 0;
move b,shift_amt2;
lsh a,0(b); ! Shift left by SHIFT_AMT2;
! Now we begin to store the mask;
move c,first_word;
move d,num_rows;
loop: iorm a,0(c);
add c,row_size; ! Go to next row;
sojg d,loop; ! Unless we're all done;
end;
first_word ← first_word + 1; ! For next column;
! We set H to 0 to make the next calculation of SHIFT_AMT1 and
SHIFT_AMT2 come out right. The actual value of H is no longer
important, so long as H land 31 = 0.;
h ← 0;
num_cols ← num_cols - 32 + shift_amt1;
end "one column of words";
end "set_rule";
Comment RULE_PIXELS rounds a dimension in the DVI file into the correct
number of pixels for the height or width of a rule.;
simple integer procedure rule_pixels(integer x);
begin "rule_pixels"
integer n;
n ← -(conv * x + .5);
return(-n);
end "rule_pixels";
Comment SET_VECTOR draws a diagonal line between the point described by H1
and V1 and the point described by H2 and V2 using the current pen.
We turn on all pixels inside the polygonal region traced out by the
pen polygon as it moves along the line. The returned value is TRUE
if this region contains pixels that are out of range. In this case
nothing is drawn.
This routine immediately converts from dvi units to pixels scaled
by 2↑19. All internal computations are done in these coordinates and
the results are exact except for rounding error in the initial conversion.
When the edge of the stroke passes exactly through pixel centers, we
resolve disputes by effectively pretending that the entire stroke is
shifted by a minute amount (ε,ε↑2). In the limit as ε→0 this yields
a well defined set of pixels.
The new coordinates (x,y) correspond directly to (h,v), but the
following comments refer to the +y direction as `up' or `North'.
Everything is invariant under this reflection;
boolean procedure set_vector(integer h1,v1,h2,v2);
begin "set_vector"
integer xstart, ystart, xend, yend; ! pen track in scaled pixels;
integer radius; ! pen radius in scaled pixels;
integer low_hh, low_vv, high_hh, high_vv;! maximum possible range;
integer v_number; ! cur_pen index for main offset;
integer off_x, off_y; ! main offset vector (unscaled);
integer x1, y1; ! Start pos for do_line (scaled);
integer x, y, offset; ! current endpoint and offset pair;
integer buffer_loc; ! last used location in edge buffer;
integer row_off; ! vv - buffer_loc (left side only)
(constant during each invocation);
! The following routine computes a line from (x1,y1) to (x,y) plus the
pen offset corresponding to offset (i.e. scale both coordinates by
2↑18 so that they are multiples of 1/2 scaled pixel). Whenever the
line passes an integer y-coordinate, the floor of the x-coordinate is
put in the edge buffer for that row. Logically, an entry of e in this
array means that there is a black/white boundary between pixels e
and e+1;
simple procedure do_line;
start_code "do line"
label xxfixed, loop, loopst, exit1, exit2;
define y2=1, x2=2; ! ending point in scaled pixels;
define dy=3, dx=4; ! differences that determine slope;
define m=4, dxx=5; ! integer slope and remainder. Note overlap;
define hh=6, xx=7; ! edge position and residual mod dy;
define yy='10; ! -(y advance needed to reach first row);
define sp='13, cnt='14; ! pointer into edge buffer and loop count;
hrlz y2, offset; ! Get y offset;
hllz x2, offset; ! Get x offset;
tlne y2, '400000; ! Is y positive?;
add x2, ['1000000]; ! No. Correct x;
add x2, x; ! Finish computing ending point;
add y2, y;
dmove dy, y2; ! dy ← y2 and dx ← x2;
sub dx, x1; ! Compute difference vector in scaled pix;
sub dy, y1;
move yy, y1; ! Get the starting y value;
tlz yy, '777776; ! and find its fractional part;
move cnt, yy; ! Get ready to compute loop count;
add cnt, dy; ! Add height of line to fractional part;
ash cnt, -19; ! and take integer part;
jumpe cnt, exit2; ! Quit if there is nothing to do;
move sp, buffer_loc; ! Prepare stack pointer for output buffer;
sub yy, ['2000000]; ! Finish computing advance amount;
mul yy, dx; ! Find yy*dx destroying yy;
move hh, x1;
mul hh, dy; ! Now x1*dy is in hh and xx;
dsub hh, yy; ! Now hh contains x1*dy - yy*dx;
ashc hh, -19; ! dy times intercept with 1st row, unscaled;
div hh, dy; ! normal hh and xx calculation;
jumpge xx, xxfixed; ! Is residual positive?;
add xx, dy; ! No. Fix hh and xx so it is;
subi hh, 1;
xxfixed:idiv dx, dy; ! Find m and dxx. Note that dx≡m;
jumpge dxx, loopst; ! Is residual slope positive?;
add dxx, dy; ! No. Fix m and dxx so it is;
subi m, 1;
jrst loopst; ! Go to logical start of loop;
loop:add hh, m; ! Update edge position;
add xx, dxx; ! Update residual mod dy;
camge xx, dy; ! Is residue at least one pixel?;
jrst loopst; ! No. Skip the fix-up;
sub xx, dy; ! Yes. Fix it so it isn't;
addi hh, 1; ! and adjust edge position accordingly;
loopst:push sp, hh; ! Write out a new edge;
sojg cnt, loop; ! and test if it was the last one;
exit1:hrrzm sp, buffer_loc; ! Save the new buffer location;
exit2:movem x2, x1; ! Write out new starting coordinates;
movem y2, y1;
end "do line";
! Here are two tables that are used for putting bits into the page buffer;
preload_with forc i←0 stepc 1 untilc 31
doc {(1 lsh 35) ash -i ifc i<31 thenc , endc} endc;
saf own integer array rtable[0:31];
preload_with forc i←0 stepc 1 untilc 31
doc {lnot(((1 lsh 35) ash -i)lor '17) ifc i<31 thenc , endc} endc;
saf own integer array ltable[0:31];
! The following routine takes two lists of edges ending at locations
lloc and rloc, adding r_off to edges from the second list and adds
to rows of the pagebuf array starting at lloc+row_off an countint
down. When filling between edges e1 and e2, we turn on all pixels
in columns >e1 but ≤e2;
simple procedure do_fill(integer lloc, rloc, nrows, r_off);
start_code "do fill"
label loop, test, hard, word1, stop;
define lref=1,rref=2; ! Via indirection these refer to edge lists;
define cnt=3, off=4; ! loop counter and offset into pagebuf;
define x=5, m=6; ! xor of 2 edges and mask to or into buffer;
define la=7, ra='10; ! address for left and right edge positions;
define b='11; ! bit position for one edge;
movei off, access(pagebuf[lloc+row_off,0]);
move cnt, nrows;
jumple cnt, stop; ! Quit if there is nothing to do;
move lref, lloc; ! Compute offset for left side;
sub lref, cnt;
hrli lref, cnt; ! Now `@lref' refers to a left side edge;
move rref, rloc; ! Same for right side;
sub rref, cnt;
hrli rref, cnt; ! Now `@rref' refers to a right side edge;
loop:move la, @lref; ! Compute left edge and store temporarily;
move x, @rref; ! Compute right edge;
add x, r_off;
xor x, la; ! Find xor of left and right edge positions;
move b, la; ! Save a copy of edge position;
ash la, -5; ! and compute the corresponding address;
add la, off;
andi b, '37; ! Find bit postion for left edge;
move m, (b)ltable[0]; ! Get mask for left edge;
tdze x, ['777777777740];! Are the edges in the same word?;
jrst hard; ! No. Go deal with a multi-word range;
xor b, x; ! Now get the right side bit position;
and m, (b)rtable[0]; ! Yes. And right side bits into mask;
iorm m, (la); ! Write into the page buffer;
test:sub off, row_size; ! Set up pagebuf offset for next row;
sojg cnt, loop; ! Repeat for the next row if any;
jrst stop; ! Otherwise quit;
hard:iorm m, (la); ! Write leftmost bits into page buffer;
xor b, x; ! Now get the right side bit position;
move ra, @rref; ! Get address for right side edge;
add ra, r_off;
ash ra, -5;
add ra, off;
move m, (b)rtable[0]; ! Set mask for right edge;
iorm m, (ra); ! Write rightmost bits into page buffer;
sub ra, la; ! Find number of words of ones needed;
sojle ra, test; ! and go on to the next row if none;
hrli la, ra; ! Make la look like an addres indexed by ra;
hrroi m, '777762; ! Load an all black graphics word;
word1:movem m, @la; ! Paint 32 bits;
sojg ra, word1; ! and repeat for the next word;
jrst test; ! Test for doneness and go on to next row;
stop:end "do fill";
! Convert from dvi units to pixels scaled by 2↑19 offset so
that multiples of 2↑19 correspond to pixel centers. This is a little
tricky: It is really the lower left corner of pixel (hh,vv) that
has dvi coordinates (hh/conv,vv/conv), but we want the center of the
pixel to scaled pixel coordinates (hh*2↑19,vv*2↑19);
xstart ← h1*(2.0↑19)*conv - (2.0↑18);
ystart ← v1*(2.0↑19)*conv + (2.0↑18);
xend ← h2*(2.0↑19)*conv - (2.0↑18);
yend ← v2*(2.0↑19)*conv + (2.0↑18);
! Switch, if necessary, to make stroke travel in positive y direction;
if ystart > yend then
begin xstart ↔ xend; ystart ↔ yend; end;
! Compute bounding box in scaled pixels and round appropriately;
radius ← -(cur_pen[1] lsh 18);
low_vv ← (ystart-radius) ash -19 + 1;
high_vv ← (yend+radius) ash -19;
low_hh ← ((xstart min xend)-radius) ash -19 + 1;
high_hh ← ((xstart max xend)+radius) ash -19;
! Make sure everything is in range.;
if low_hh < left_hh or high_hh > right_hh or
low_vv < top_vv or high_vv > bottom_vv then return(true);
lowest_hh ← lowest_hh min low_hh;
highest_hh ← highest_hh max high_hh;
lowest_vv ← lowest_vv min low_vv;
highest_vv ← highest_vv max high_vv;
begin "choose pen offset"
integer dx, dy; ! Stroke direction rotated -90 deg;
integer top_loc; ! Vertex number and pointer thereto;
dx ← yend-ystart;
dy ← xstart-xend;
! Find which vertex of the current pen has largest (dx,dy) component;
top_loc ← location(cur_pen[pen_v]) + (pen_v+1) ash 18;
start_code
label loop,stop;
define pv='15, v1=1, x=2, y=4;
move pv, top_loc; ! Stack pointer pv gets last vertex;
loop:pop pv, v1; ! Get top vertex and go on to next;
tlnn pv, '777776; ! Did we just get the last vertex?;
jrst stop; ! Yes. Jump out;
sub v1, (pv); ! No. Subtract previous vertex from v1;
hlre x, v1; ! Get the x part of the difference;
hrrz y, v1; ! Get the difference in y;
mul x, dx; ! x*dx;
mul y, dy; ! y*dy;
dadd x, y; ! Now the dot product is in x;
jumpl x, loop; ! Repeat if not reached perpendicular;
move v1, +1(pv); ! Now either way v1 will be the offset;
stop:hlrzm pv, v_number; ! Extract vertex number from stack pointer;
hrrem v1, off_y; ! Save the y component of the offset;
addi v1, '400000; ! Correct x component in case y was <0;
hlrem v1, off_x; ! Save the adjusted x component;
end;
end "choose pen offset";
begin "actual drawing"
saf integer array v_edge[low_vv:high_vv]; ! b/w edges in each row;
saf integer array aux_edge[0:radius ash-18];! edges for right side;
integer i, j, k;
integer loc1, loc2; ! buffer_loc before and
after main do_line call;
integer loc3; ! buffer_loc after rt side;
integer buff0; ! loc of start of aux_edge;
integer bot_xoff; ! x part of cur_pen[1];
define line_to_offset(o) = {begin offset←o; do_line; end};
! Start at the bottom and go around the left edge, filling v_edge;
bot_xoff ← (cur_pen[1]+'400000) land '777777000000;
x1 ← xstart - bot_xoff;
y1 ← ystart-radius;
buffer_loc ← location(v_edge[low_vv]) - 1;
row_off ← low_vv-1-buffer_loc;
x ← xstart;
y ← ystart;
offset ← -cur_pen[pen_v];
for i ← pen_v-1 downto v_number do line_to_offset(-cur_pen[i]);
! Switch to the end of the stroke and add the main line;
x ← xend;
y ← yend;
loc1 ← buffer_loc;
do_line;
loc2 ← buffer_loc;
! Now finish puting left side edges into the v_edge buffer;
for i ← v_number-1 step -1 until 1 do line_to_offset(-cur_pen[i]);
loc3 ← buffer_loc;
! Switch to the auxiliary buffer and start up the right side;
x1 ← xstart + bot_xoff;
y1 ← ystart-radius;
buff0 ← buffer_loc ← location(aux_edge[0]) - 1;
x ← xstart;
y ← ystart;
offset ← cur_pen[1];
for i ← 2 thru v_number do line_to_offset(cur_pen[i]);
do_fill(loc1+off_y, buffer_loc, buffer_loc-buff0, 0);
! Fill to the left of the offset version of the main line;
do_fill(loc2+off_y, loc2, loc2-loc1, off_x);
! Continue up the right side of the stroke above the main line;
x1 ← x1 + xend-xstart;
y1 ← y1 + yend-ystart;
buffer_loc ← buff0;
x ← xend;
y ← yend;
for i ← v_number+1 thru pen_v do line_to_offset(cur_pen[i]);
do_fill(loc3, buffer_loc, buffer_loc-buff0, 0);
end "actual drawing";
return(false);
end "set_vector";
Comment SET_RECTANGLE performs bit-shading on a rectangle. The meaning of
the arguments can be found in DVIDOV.IAZ[UP,DOC]. Unlike DVIdover, this
program implements all of the functions described there.;
simple procedure set_rectangle(integer shading,command,hh1,vv1,hh2,vv2);
begin "set_rectangle"
saf own integer array row_mask[0:3];
integer i,operation;
boolean and_function,clear_function;
integer h,v,height,width; ! Similar to SET_RULE parameters.;
integer first_row,num_rows,num_cols,first_word,shift_amt1,shift_amt2;
! First we construct the mask. ROW_MASK[i] will be used for each row
whose row number is ≡ i mod 4.;
for i ← 0 thru 3 do
row_mask[i] ← ((shading lsh -(4*(3-i)) land '17) * '2104210421) lsh 4;
! Set operation depending on command. Some commands also cause the shading
parameter to be ignored. AND_FUNCTION is set true if the operation
requires ANDing in the bits to be changed, but not changing any others.
CLEAR_FUNCTION is set true if the changed bits should be cleared before
being operated on.;
and_function ← clear_function ← false;
case command of begin "case command"
["0"] begin "clear"
clear_function ← true;
operation ← '255000000000; ! JFCL;
end "clear";
["1"] begin "blacken"
row_mask[0] ← row_mask[1] ← row_mask[2] ← row_mask[3] ← (-1) lsh 4;
operation ← '436303000000; ! IORM 6,0(3);
end "blacken";
["s"] begin "substitute"
clear_function ← true;
operation ← '436303000000; ! IORM 6,0(3);
end "substitute";
["o"] operation ← '436303000000; ! IORM 6,0(3);
["x"] operation ← '432303000000; ! XORM 6,0(3);
["a"] begin "and"
and_function ← true;
operation ← '406303000000; ! ANDM 6,0(3);
end "and";
else begin
page_warn(<"Illegal code """ & command,
""" in \special{rectangle} command." & ↓>);
return
end
end "case command";
if hh1 < hh2 then begin
h ← hh1;
width ← hh2 - hh1
end
else begin
h ← hh2;
width ← hh1 - hh2
end;
if vv1 < vv2 then begin
v ← vv2;
height ← vv2 - vv1
end
else begin
v ← vv1;
height ← vv1 - vv2
end;
! Now we essentially do the same as SET_RULE, with a few additions.;
! We refuse to set rules whose reference point is out of range;
if not ((left_hh ≤ h ≤ right_hh) and
(top_vv ≤ v ≤ bottom_vv)) then return;
first_row ← (v-height+1) max top_vv;
if (num_rows ← v - first_row + 1) = 0 then return;
if (num_cols ← (h+width min right_hh+1) - h) = 0 then return;
lowest_hh ← lowest_hh min h;
highest_hh ← highest_hh max (h+num_cols-1);
lowest_vv ← lowest_vv min first_row;
highest_vv ← highest_vv max v;
first_word ← location(pagebuf[first_row, h ash -5]);
while num_cols > 0 do begin "one column of words"
! In this loop, we handle one column of words, starting at FIRST_WORD.;
! SHIFT_AMT1 is 32 minus the number of 1 bits per word in this column.;
shift_amt1 ← (32-num_cols) max (h land 31);
! SHIFT_AMT2 is an amount needed to get the mask in the proper position.;
shift_amt2 ← shift_amt1 - (h land 31);
start_code
define a=1, b=2, c=3, d=4, e=5, f=6;
label loop,andlp,endit;
seto a,; ! A ← all 1's;
movn b,shift_amt1;
lsh a,0(b); ! Shift right by SHIFT_AMT1;
trz a,'17; ! Set right 4 bits to 0;
move b,shift_amt2;
lsh a,0(b); ! Shift left by SHIFT_AMT2;
! Now do the operation on each row in this column;
move c,first_word;
move d,num_rows;
move e,first_row;
loop: andi e,3; ! Get row number mod 4;
skipe clear_function;
andcam a,0(c); ! Clear the bits in the word;
move f,row_mask[0](e);
and f,a; ! Select proper part of the mask;
skipe and_function;
orcm f,a; ! Set bits outside of mask to 1;
xct operation;
add c,row_size; ! Go to next row;
addi e,1;
sojg d,loop; ! Unless we're all done;
end;
first_word ← first_word + 1; ! For next column;
! We set H to 0 to make the next calculation of SHIFT_AMT1 and
SHIFT_AMT2 come out right. The actual value of H is no longer
important, so long as H land 31 = 0.;
h ← 0;
num_cols ← num_cols - 32 + shift_amt1;
end "one column of words";
end "set_rectangle";
Comment SPECIAL_COMMAND handles \special commands in TeX input.;
procedure special_command;
begin "special_command"
string command_name,s;
integer p,q;
label error_here;
procedure check_point(integer p);
begin "check_point"
if 0 ≤ p ≤ highest_point then return;
page_warn(<"Point index ",p," out of range">);
go to error_here;
end "check_point";
s ← special_string;
scan(s,skip_blanks,brchar);
command_name ← scan(s,to_blank,brchar);
if equ(command_name,"point") then begin "point"
check_point(p ← intscan(s,brchar));
point_h[p] ← h;
point_v[p] ← v;
return;
end "point"
else if equ(command_name,"join") then begin "join"
real pen_size;
boolean out_of_range; ! TRUE if an error message is printed.;
out_of_range ← false;
pen_size ← abs(realscan(s,brchar));
if pen_size ≠ cur_pen_size then make_pen(pen_size);
check_point(q ← intscan(s,brchar));
while scan(s,skip_blanks,brchar) do begin "one segment"
p ← q;
check_point(q ← intscan(s,brchar));
if set_vector(point_h[p],point_v[p],
point_h[q],point_v[q]) then begin
if out_of_range then print(", ",p," to ",q)
else begin
page_warn(<"Line segment(s) out of range: ",p,
" to ",q>);
if page_warn_count ≥ 0 then out_of_range ← true;
end;
end;
end "one segment";
if not out_of_range then return;
end "join"
else if equ(command_name,"rectangle") then begin "rectangle"
integer shading,command;
shading ← intscan(s,brchar);
scan(s,skip_blanks,brchar);
command ← lop(s);
p ← intscan(s,brchar);
q ← intscan(s,brchar);
set_rectangle(shading,command,
point_h[p]*conv,point_v[p]*conv,
point_h[q]*conv,point_v[q]*conv);
return;
end "rectangle"
! \special{moveto ...} is not officially supported;
else if equ(command_name,"moveto") then begin "moveto"
check_point(p ← intscan(s,brchar));
h ← point_h[p];
v ← point_v[p];
return;
end "moveto"
else print("Unknown command name");
! We get here only when there has been an error of some sort.
PAGE_WARN_COUNT tells us whether the error message has been printed,
in which case we complete it.;
error_here:
if page_warn_count ≥ 0 then
print(" in:" & ↓ & " \special{",special_string,"}" & ↓);
end "special_command";
Comment DO_PAGE reads from the DVI file starting at the current position,
and fills PAGEBUF.;
procedure do_page;
begin "do_page"
integer dvicmd,i,j,rule_height,rule_width,pxl_height,pxl_width;
integer pagebuflen;
boolean brokenword;
label finish_page;
if forcing_page_read then begin
forcing_page_read ← false;
go_to_page(current_page)
end;
arrclr(point_h);
arrclr(point_v);
! Initialize LOWEST and HIGHEST variables so that we show at least as
much as the postamble said is in the file.;
lowest_vv ← lowest_hh ← 0;
highest_vv ← max_vv;
highest_hh ← max_hh;
stack_top ← -1;
page_warn_count ← page_warn_max; ! Reset at beginning of each page;
blank_ddbuf;
if dvi_version = 1 then begin "version 1"
saf integer array stack[0:stacksize,1:6]; ! Stack for DVI quantities;
! Version 1 DVI commands;
define NOP={128}, BOP={129}, EOP={130}, PST={131},
DVIPUSH={132}, DVIPOP={133},
VERTRULE={134}, HORZRULE={135}, HORZCHAR={136}, DVIFONT={137},
W4={138}, W3={139}, W2={140}, W0={141},
X4={142}, X3={143}, X2={144}, X0={145},
Y4={146}, Y3={147}, Y2={148}, Y0={149},
Z4={150}, Z3={151}, Z2={152}, Z0={153},
FONTNUM={154}; ! to 217;
while true do begin "main loop for version 1"
dvicmd ← getnext;
if 0 ≤ dvicmd ≤ 127 then begin "vertchar"
integer char_width; ! in rsu's;
if brokenword then begin
brokenword ← false;
hh ← h * conv;
end;
char_width ← set_char(dvicmd);
h ← h + char_width;
hh ← hh + (i ← char_width * conv);
end "vertchar"
else if FONTNUM ≤ dvicmd ≤ FONTNUM + 63 then find_font(dvicmd - FONTNUM)
else case dvicmd of begin "case dvicmd"
[NOP] ;
[BOP] begin "BOP"
arrclr(pagebuf,2);
h ← v ← 0;
wamt ← xamt ← yamt ← zamt ← 0;
brokenword ← true;
! Skip counter values and previous page ptr.;
for i ← 0 thru 10 do getint;
end "BOP";
[EOP] begin "EOP"
if stack_top ≠ -1 then error("Stack not empty at end of page");
go to finish_page;
end "EOP";
[PST] error("Shouldn't be reading postamble byte");
[DVIPUSH] begin "DVIPUSH"
if (stack_top ← stack_top + 1) > stacksize then
error("Stack overflow");
stack[stack_top,1] ← h;
stack[stack_top,2] ← v;
stack[stack_top,3] ← wamt;
stack[stack_top,4] ← xamt;
stack[stack_top,5] ← yamt;
stack[stack_top,6] ← zamt;
brokenword ← true;
end "DVIPUSH";
[DVIPOP] begin "DVIPOP"
h ← stack[stack_top,1];
v ← stack[stack_top,2];
wamt ← stack[stack_top,3];
xamt ← stack[stack_top,4];
yamt ← stack[stack_top,5];
zamt ← stack[stack_top,6];
if (stack_top ← stack_top - 1) < -1 then
error("Stack underflow");
brokenword ← true;
end "DVIPOP";
[VERTRULE][HORZRULE] begin "RULE"
rule_height ← getint;
rule_width ← getint;
pxl_height ← rule_pixels(rule_height);
pxl_width ← rule_pixels(rule_width);
if brokenword then begin
brokenword ← false;
hh ← h * conv;
end;
if rule_height and rule_width then
set_rule(hh,v*conv,pxl_height,pxl_width);
if dvicmd = VERTRULE then begin
h ← h + rule_width;
hh ← hh + pxl_width;
end;
end "RULE";
[HORZCHAR] begin "HORZCHAR"
if brokenword then begin
brokenword ← false;
hh ← h * conv;
end;
set_char(getnext);
end "HORZCHAR";
[W4] begin
h ← h + (wamt ← getint);
brokenword ← true;
end;
[W3] begin
h ← h + (wamt ← threebites);
brokenword ← true;
end;
[W2] begin
h ← h + (wamt ← twobites);
brokenword ← true;
end;
[W0] begin
h ← h + wamt;
brokenword ← true;
end;
[X4] begin
h ← h + (xamt ← getint);
brokenword ← true;
end;
[X3] begin
h ← h + (xamt ← threebites);
brokenword ← true;
end;
[X2] begin
h ← h + (xamt ← twobites);
brokenword ← true;
end;
[X0] begin
h ← h + xamt;
brokenword ← true;
end;
[Y4] begin
v ← v + (yamt ← getint);
end;
[Y3] begin
v ← v + (yamt ← threebites);
end;
[Y2] begin
v ← v + (yamt ← twobites);
end;
[Y0] begin
v ← v + yamt;
end;
[Z4] begin
v ← v + (zamt ← getint);
end;
[Z3] begin
v ← v + (zamt ← threebites);
end;
[Z2] begin
v ← v + (zamt ← twobites);
end;
[Z0] begin
v ← v + zamt;
end;
else error("Illegal command code (" & cvs(dvicmd) & ") in DVI file")
end "case dvicmd"
end "main loop for version 1"
end "version 1"
else if dvi_version = 2 then begin "version 2"
saf integer array stack[0:stack_depth,1:6]; ! Stack for DVI quantities;
! Version 2 DVI commands;
define SETCHAR0={0}, SETCHAR127={127},
SET1={128}, SET2={129}, SET3={130}, SET4={131}, SETRULE={132},
PUT1={133}, PUT2={134}, PUT3={135}, PUT4={136}, PUTRULE={137},
NOP={138}, BOP={139}, EOP={140}, DVIPUSH={141}, DVIPOP={142},
RIGHT1={143}, RIGHT2={144}, RIGHT3={145}, RIGHT4={146},
W0={147}, W1={148}, W2={149}, W3={150}, W4={151},
X0={152}, X1={153}, X2={154}, X3={155}, X4={156},
DOWN1={157}, DOWN2={158}, DOWN3={159}, DOWN4={160},
Y0={161}, Y1={162}, Y2={163}, Y3={164}, Y4={165},
Z0={166}, Z1={167}, Z2={168}, Z3={169}, Z4={170},
FNTNUM0={171}, FNTNUM63={234},
FNT1={235}, FNT2={236}, FNT3={237}, FNT4={238},
XXX1={239}, XXX2={240}, XXX3={241}, XXX4={242},
FNTDEF1={243}, FNTDEF2={244}, FNTDEF3={245}, FNTDEF4={246},
PRE={247}, POST={248}, POST_POST={249};
while true do begin "main loop for version 2"
label char_here, put_here, read_special;
dvicmd ← getnext;
if SETCHAR0 ≤ dvicmd ≤ SETCHAR127 then begin "SETCHAR"
integer char_width; ! in rsu's;
char_here: if brokenword then begin
brokenword ← false;
hh ← h * conv;
end;
char_width ← set_char(dvicmd);
h ← h + char_width;
hh ← hh + (i ← char_width * conv);
! added by DEK:;
i←h*conv; if abs(i-hh)>1 then
if i>hh then hh←i-1 else hh←i+1;
end "SETCHAR"
else if FNTNUM0 ≤ dvicmd ≤ FNTNUM63 then find_font(dvicmd - FNTNUM0)
else case dvicmd of begin "case dvicmd"
[SET1] begin "SET1"
dvicmd ← getnext;
go to char_here;
end "SET1";
[SET2] begin "SET2"
dvicmd ← twobites;
go to char_here;
end "SET2";
[SET3] begin "SET3"
dvicmd ← threebites;
go to char_here;
end "SET3";
[SET4] begin "SET4"
dvicmd ← fourbites;
go to char_here;
end "SET4";
[SETRULE][PUTRULE] begin "RULE"
rule_height ← getint;
rule_width ← getint;
pxl_height ← rule_pixels(rule_height);
pxl_width ← rule_pixels(rule_width);
if brokenword then begin
brokenword ← false;
hh ← h * conv;
end;
if rule_height and rule_width then
set_rule(hh,v*conv,pxl_height,pxl_width);
if dvicmd = SETRULE then begin
h ← h + rule_width;
hh ← hh + pxl_width;
! added by DEK:;
i←h*conv; if abs(i-hh)>1 then
if i>hh then hh←i-1 else hh←i+1;
end;
end "RULE";
[PUT1] begin "PUTCHAR"
dvicmd ← getnext;
put_here: if brokenword then begin
brokenword ← false;
hh ← h * conv;
end;
set_char(dvicmd);
end "PUTCHAR";
[PUT2] begin "PUT2"
dvicmd ← twobites;
go to put_here;
end "PUT2";
[PUT3] begin "PUT3"
dvicmd ← threebites;
go to put_here;
end "PUT3";
[PUT4] begin "PUT4"
dvicmd ← fourbites;
go to put_here;
end "PUT4";
[NOP] ;
[BOP] begin "BOP"
arrclr(pagebuf,2);
h ← v ← 0;
wamt ← xamt ← yamt ← zamt ← 0;
brokenword ← true;
! Skip counter values and previous page ptr.;
for i ← 0 thru 10 do getint;
end "BOP";
[EOP] begin "EOP"
if stack_top ≠ -1 then error("Stack not empty at end of page");
go to finish_page;
end "EOP";
[DVIPUSH] begin "DVIPUSH"
if (stack_top ← stack_top + 1) > stack_depth then
error("Stack overflow");
stack[stack_top,1] ← h;
stack[stack_top,2] ← v;
stack[stack_top,3] ← wamt;
stack[stack_top,4] ← xamt;
stack[stack_top,5] ← yamt;
stack[stack_top,6] ← zamt;
brokenword ← true;
end "DVIPUSH";
[DVIPOP] begin "DVIPOP"
h ← stack[stack_top,1];
v ← stack[stack_top,2];
wamt ← stack[stack_top,3];
xamt ← stack[stack_top,4];
yamt ← stack[stack_top,5];
zamt ← stack[stack_top,6];
if (stack_top ← stack_top - 1) < -1 then
error("Stack underflow");
brokenword ← true;
end "DVIPOP";
[RIGHT1] begin
h ← h + getnext;
brokenword ← true;
end;
[RIGHT2] begin
h ← h + twobites;
brokenword ← true;
end;
[RIGHT3] begin
h ← h + threebites;
brokenword ← true;
end;
[RIGHT4] begin
h ← h + fourbites;
brokenword ← true;
end;
[W0] begin
h ← h + wamt;
brokenword ← true;
end;
[W1] begin
h ← h + (wamt ← getnext);
brokenword ← true;
end;
[W2] begin
h ← h + (wamt ← twobites);
brokenword ← true;
end;
[W3] begin
h ← h + (wamt ← threebites);
brokenword ← true;
end;
[W4] begin
h ← h + (wamt ← getint);
brokenword ← true;
end;
[X0] begin
h ← h + xamt;
brokenword ← true;
end;
[X1] begin
h ← h + (xamt ← getnext);
brokenword ← true;
end;
[X2] begin
h ← h + (xamt ← twobites);
brokenword ← true;
end;
[X3] begin
h ← h + (xamt ← threebites);
brokenword ← true;
end;
[X4] begin
h ← h + (xamt ← getint);
brokenword ← true;
end;
[DOWN1] begin
v ← v + getnext;
end;
[DOWN2] begin
v ← v + twobites;
end;
[DOWN3] begin
v ← v + threebites;
end;
[DOWN4] begin
v ← v + fourbites;
end;
[Y0] begin
v ← v + yamt;
end;
[Y1] begin
v ← v + (yamt ← getnext);
end;
[Y2] begin
v ← v + (yamt ← twobites);
end;
[Y3] begin
v ← v + (yamt ← threebites);
end;
[Y4] begin
v ← v + (yamt ← getint);
end;
[Z0] begin
v ← v + zamt;
end;
[Z1] begin
v ← v + (zamt ← getnext);
end;
[Z2] begin
v ← v + (zamt ← twobites);
end;
[Z3] begin
v ← v + (zamt ← threebites);
end;
[Z4] begin
v ← v + (zamt ← getint);
end;
[FNT1] begin
find_font(getnext);
end;
[FNT2] begin
find_font(twobites);
end;
[FNT3] begin
find_font(threebites);
end;
[FNT4] begin
find_font(fourbites);
end;
[XXX1] begin
i ← getnext;
go to read_special;
end;
[XXX2] begin
i ← bites2;
go to read_special;
end;
[XXX3] begin
i ← bites3;
go to read_special;
end;
[XXX4] begin
i ← bites4;
read_special: special_string ← "";
for j ← 1 thru i do special_string ← special_string & getnext;
special_command;
end;
[FNTDEF1] begin
! Skip over the font definition;
i ← getnext; ! font number;
i ← bites4; ! checksum;
i ← bites4; ! at size;
i ← bites4; ! design size;
i ← getnext + getnext; ! length of name;
for j ← 1 thru i do getnext; ! name;
end;
[FNTDEF2] begin
i ← bites2; i ← bites4; i ← bites4; i ← bites4;
i ← getnext + getnext; for j ← 1 thru i do getnext;
end;
[FNTDEF3] begin
i ← bites3; i ← bites4; i ← bites4; i ← bites4;
i ← getnext + getnext; for j ← 1 thru i do getnext;
end;
[FNTDEF4] begin
i ← bites4; i ← bites4; i ← bites4; i ← bites4;
i ← getnext + getnext; for j ← 1 thru i do getnext;
end;
[PRE] begin
if dvi_version ≠ getnext then
error("Bad identifier in preamble");
! Ignore the rest, since we already read the postamble.;
i ← bites4; i ← bites4; i ← bites4; i ← getnext;
for j ← 1 thru i do getnext;
end;
[POST] error("Shouldn't be reading postamble byte");
[POST_POST] error("Shouldn't be reading postamble end byte");
else error("Illegal command code (" & cvs(dvicmd) & ") in DVI file")
end "case dvicmd"
end "main loop for version 2"
end "version 2"
else error("This can't happen - version > 2");
finish_page:
! Here we set the amount that will be displayed in each windowful, based
on what was on the page.;
num_rows ← ysize min (highest_vv-lowest_vv+1);
num_cols ← xwords min (highest_hh-lowest_hh+32) lsh -5;
! The following code was removed because it isn't really needed, and was causing
more bugs than it was worth.;
! ! Finally we set the low-order 4 bits of each word in PAGEBUF to 02 so
! that they are interpreted as graphics words. (This is in case, for
! some reason, they were clobbered by SETRULE or SETCHAR, though they
! shouldn't be.);
!
! pagebuflen ← row_size * (bottom_vv-top_vv-1);
! start_code
! label loop;
! movei '13,2;
! move '14,pagebuflen;
! movsi '15,'000400; ! '15 ← byte ptr for low 4 bits;
! add '15,pagebuf; ! gets addr of first word;
! loop: dpb '13,'15;
! addi '15,1;
! sojg '14,loop
! end;
end "do_page";
Comment Here is where WORK begins;
integer input_char,bucky_bits,char;
integer argument,sign,horiz_pos;
boolean argument_on;
label more_cmd, unrecognized;
define infinity = 131064; ! That's what E uses;
define control = '200, meta = '400;
! Initialize, and display the first page;
init_ddbuf;
current_page ← (current_page max 1) min number_of_pages;
go_to_page(current_page);
do_page; ! Fills PAGEBUF by reading DVI file;
top_row ← 0;
bottom_row ← num_rows - 1;
left_col ← 0;
right_col ← num_cols - 1;
do_output;
! The loop beginning here accepts user commands, and performs whatever
actions are requested by those commands.;
while true do begin "command loop"
argument ← 0;
argument_on ← false;
sign ← " ";
ttyset(7,location(horiz_pos)); ! Should we do a crlf?;
if horiz_pos > 40 then print(↓);
more_cmd:
input_char ← inchrw;
if (char ← input_char land '177) = '15 then inchrw; ! eat lf after cr;
bucky_bits ← input_char land '600;
if "0" ≤ char ≤ "9" then begin
argument ← argument * 10 + char - "0";
argument_on ← true;
go to more_cmd;
end;
case char of begin "case char"
["∞"] begin
argument ← infinity;
argument_on ← true;
go to more_cmd;
end;
["+"]["-"] begin
sign ← char;
go to more_cmd;
end;
[alt] ;
[ff] begin "ff"
if argument_on then
if argument = 0 then
bottom_row ← bottom_row + (window_lines div 2)
else bottom_row ← bottom_row + window_lines * argument
else if (bucky_bits land control) and (bottom_row ≥ highest_vv)
and current_page < number_of_pages then begin "next page"
current_page ← current_page + 1;
do_page;
bottom_row ← num_rows - 1;
end "next page"
else bottom_row ← bottom_row + window_lines;
bottom_row ← bottom_row min highest_vv;
top_row ← bottom_row - num_rows + 1;
do_output;
end "ff";
[vt] begin "vt"
if argument_on then
if argument = 0 then
top_row ← top_row - (window_lines div 2)
else top_row ← top_row - window_lines * argument
else if (bucky_bits land control) and (top_row ≤ lowest_vv)
and current_page > 1 then begin "previous page"
current_page ← current_page - 1;
go_to_page(current_page);
do_page;
top_row ← highest_vv - num_rows + 1;
end "previous page"
else top_row ← top_row - window_lines;
top_row ← top_row max lowest_vv;
bottom_row ← top_row + num_rows - 1;
do_output;
end "vt";
["→"] begin
left_col ← (left_col-12) max (lowest_hh ash -5);
right_col ← left_col + num_cols - 1;
do_output;
end;
["←"] begin
right_col ← (right_col+12) min (highest_hh ash -5);
left_col ← right_col - num_cols + 1;
do_output;
end;
["'"] begin
left_col ← (left_col-1) max (lowest_hh ash -5);
right_col ← left_col + num_cols - 1;
do_output;
end;
["`"] begin
right_col ← (right_col+1) min (highest_hh ash -5);
left_col ← right_col - num_cols + 1;
do_output;
end;
["?"] help_message;
["B"]["b"] begin "B"
if not argument_on then argument ← 1;
bottom_row ← (bottom_row + small_lines * argument) min highest_vv;
top_row ← bottom_row - num_rows + 1;
do_output;
end "B";
["E"]["e"] begin "E"
clean_up; ! Releases DVICHAN;
exit(1); ! This lets the user continue;
open(dvichan←getchan,"dsk",'17,0,0,0,brchar,eof);
lookup(dvichan,dvifname,flag);
if flag then error("Can't reread DVI file " & dvifname);
if dvilength ≠ filesize then error("Size of DVI file " &
dvifname & " has changed! Start over.");
dvi_init; ! Force next new page to position file.;
forcing_page_read ← true;
do_output; ! Re-display current page;
end "E";
["L"]["l"] begin "L"
top_row ← if argument_on then argument * max_vv div 100
- ysize div 2 max lowest_vv else lowest_vv;
if (bottom_row ← top_row + num_rows - 1) > highest_vv then begin
bottom_row ← highest_vv;
top_row ← bottom_row - num_rows + 1;
end;
do_output;
end "L";
["P"]["p"] begin "P"
integer new_page;
boolean sorry;
sorry ← false;
case sign of begin "case sign"
[" "] new_page ← if argument_on then argument
else current_page + 1;
["+"] new_page ← current_page +
(if argument_on then argument else 1);
["-"] new_page ← current_page -
(if argument_on then argument else 1)
end "case sign";
if new_page > number_of_pages then begin
sorry ← true;
new_page ← number_of_pages;
end;
if new_page < 1 then begin
sorry ← true;
new_page ← 1;
end;
if new_page ≠ current_page then begin
if new_page ≠ current_page + 1 then go_to_page(new_page);
current_page ← new_page;
do_page;
top_row ← 0;
bottom_row ← num_rows - 1;
left_col ← 0;
right_col ← num_cols - 1;
do_output;
end;
if sorry then begin
print(↓,"Sorry -- no such page. ");
continue "command loop" ! don't print " OK ";
end;
end "P";
["T"]["t"] begin "T"
if not argument_on then argument ← 1;
top_row ← (top_row - small_lines * argument) max lowest_vv;
bottom_row ← top_row + num_rows - 1;
do_output;
end "T";
["V"]["v"] begin "V"
if bucky_bits land meta then begin
break("P");
call(0,"sleep");
call(0,"sleep");
call(0,"sleep");
end;
do_output;
end "V";
["ε"]["λ"] begin "exit to E"
! preload_with cvsix("SYS"), cvsix("E"), cvsix("DMP"), 0, 0;
! safe own integer array swap_arr[0:4];
string filename;
print(↓,"File? ");
filename ← inchwl;
if _skip_ = alt then print(" Request aborted." & ↓)
else begin
filename ← (if char = "λ" then "er " else "et ")
& filename & cr & 0;
! clrbuf; ! So E's rescan will work;
start_code
define a=1, b=2;
movei a,0;
movei b,3;
ptyuuo '16,a; ! PTJOBX to turn off echoing;
move b,filename;
ptyuuo '11,a; ! PTWRS7 to type the command;
movei b,4;
ptyuuo '16,a; ! PTJOBX to turn on echoing;
end;
! clean_up;
! call(location(swap_arr[0]),"swap");
done "command loop";
end;
end "exit to E";
["π"]["}"]["@"]["#"] begin
"exit and run DVIdover, DVIpress, BOISE, DVIESP, DVIrover"
string command;
boolean modify; ! User may want to modify command;
! DEK claims he types απαε instinctively from too much E use;
! For E compatibility, we'll force the bits to be off;
if bucky_bits land control then begin
print(↓, "-- ", char & "",
" command must be typed without <control> key --", ↓);
continue "command loop";
end;
modify ← bucky_bits land meta;
if char ≠ "}" ∧ dvi_version = 1 then begin
print(↓, "-- Can only ""press"" Version 1 dvi files --", ↓);
continue "command loop";
end;
command ← (if char = "π" then "BOISE "
else if char = "@" then "r DVIesp;"
else if char = "#" then "r DVIrover;"
else if dvi_version = 1 then "r DVIpress;"
else "r DVIdover;") & dvi_farray[0] & dvi_farray[1]
& dvi_farray[2];
! Careful here. SAIL is finicky about what syntax will
properly append a null to a string.;
command ← if modify then command & 0 else command & cr & 0;
start_code
define a=1, b=2;
movei a,0;
movei b,3;
skipn modify;
ptyuuo '16,a; ! PTJOBX to turn off echoing;
move b,command;
ptyuuo '11,a; ! PTWRS7 to type the command;
movei b,4;
skipn modify;
ptyuuo '16,a; ! PTJOBX to turn on echoing;
end;
done "command loop";
end "exit and run DVIdover, DVIpress, BOISE, DVIESP, DVIrover";
else begin
unrecognized: print(↓,"Sorry -- Unrecognized command character -- ",
char_str(input_char),↓);
continue "command loop";
end
end "case char";
print(" OK ");
end "command loop";
end "work";
Comment PROCESS_SWITCHES processes switches in the command line. The global
string variable CMD_LINE contains the command line after the first
"/" (if any) when this is called.;
simple procedure process_switches;
begin "process_switches"
string switch;
integer sw_char;
integer sw_sign;
while cmd_line ≠ null do begin "one switch"
switch ← scan(cmd_line,to_slash,brchar);
sw_char ← switch[∞ for 1];
if "a" ≤ sw_char ≤ "z" then sw_char ← sw_char-32;
if switch = "-" then begin
sw_sign ← "-";
switch ← switch[2 to ∞-1];
end
else begin
sw_sign ← " ";
switch ← switch[1 to ∞-1];
end;
case sw_char of begin "case sw_char"
["F"] begin "fonts"
! /-F disables preloaded fonts;
if sw_sign = "-" then current_font ← null_record;
end "fonts";
["M"] begin "magnification"
magnification ←
if sw_sign = "-" then default_mag
else cvd(switch); ! does the right thing for /M;
end "magnification";
["P"] begin "initial page"
current_page ← cvd(switch);
end "initial page";
else begin "unknown switch"
! Just ignore it.;
end "unknown switch"
end "case sw_char";
end "one switch";
end "process_switches";
Comment Main program;
preload_fonts;
pause;
! Set DDCHAN to 0 (our channel) if we are on a DD, otherwise abort.;
quick_code
setob '13,ddflag;
ttcall 6,'13;
tlnn '13,'20000;
setzm ddflag;
end;
if ¬ddflag then error("Sorry, you need to be on a DataDisc to run this program");
ddchan ← 0;
all_done ← false;
current_page ← 1;
magnification ← default_mag; ! Remove this line to use DVI file mag as default;
! See if there is a DVI file name on the command line.;
backup;
cmd_line ← inchwl;
scan(cmd_line,to_semi,brchar);
while cmd_line = "" do begin
print("DVI file = ");
cmd_line ← inchwl
end;
open(dvichan←getchan,"dsk",'17,0,0,0,brchar,eof); ! dump mode read;
while true do begin
dvifname ← scan(cmd_line,to_slash,brchar);
scan_filename(dvifname,true); ! Remove PPN if same as alias area;
arrtran(dvi_farray,farray);
if dvi_farray[1] = "" then dvi_farray[1] ← ".DVI";
dvifname ← dvi_farray[0] & dvi_farray[1] & dvi_farray[2];
lookup(dvichan,dvifname,flag);
if flag = 0 then done;
print("Lookup failed on file ",dvifname,↓,"DVI file = ");
cmd_line ← inchwl;
end;
dvilength ← filesize;
process_switches;
open(fontchan←getchan,"dsk",'17,0,0,0,brchar,eof);
postamble;
release(fontchan);
find_pages;
work;
! Return here for exits (like "ε" and "}") to other programs.;
clean_up;
exit(0);
end "dvidd";